1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/Laserkard.pm	Wed Feb 03 03:14:09 2010 -0500
     1.3 @@ -0,0 +1,480 @@
     1.4 +package Laserkard;
     1.5 +
     1.6 +use List::Util qw(first max maxstr min minstr reduce shuffle sum);
     1.7 +use Storable;
     1.8 +use CGI::Ajax;
     1.9 +use CGI;
    1.10 +use JSON;
    1.11 +use Laserkard;
    1.12 +use base 'Exporter';
    1.13 +
    1.14 +our @EXPORT = 
    1.15 +qw(
    1.16 +material
    1.17 +template 
    1.18 +inputbox
    1.19 +display
    1.20 +change_rules
    1.21 +vanish
    1.22 +updateForm
    1.23 +cardType
    1.24 +);
    1.25 +
    1.26 +
    1.27 +
    1.28 +
    1.29 +
    1.30 +sub cardType
    1.31 +{
    1.32 +
    1.33 +return $_[0];
    1.34 +	
    1.35 +}
    1.36 +
    1.37 + 
    1.38 +
    1.39 +sub updateForm
    1.40 +
    1.41 +{
    1.42 +	
    1.43 +	
    1.44 +	$key = shift;
    1.45 +	$value = shift;
    1.46 +	$hashString = shift;
    1.47 +	
    1.48 +	$perl_hash  = decode_json $hashString;
    1.49 +
    1.50 +	%fieldHash = %$perl_hash;
    1.51 +
    1.52 +
    1.53 +	$fieldHash{$key} = $value;
    1.54 +	$ref = \%fieldHash;
    1.55 +	
    1.56 +	$utf8_encoded_json_text = encode_json  $ref ;
    1.57 +	return $utf8_encoded_json_text;
    1.58 +
    1.59 +}
    1.60 +
    1.61 +
    1.62 +
    1.63 +
    1.64 +sub material{
    1.65 +	
    1.66 +	$newvar = shift;
    1.67 +	
    1.68 +	my $t = $newvar;
    1.69 +	
    1.70 +	$newvar =~ m/([^_]*)_/;
    1.71 +	$newvar = $1;
    1.72 +	
    1.73 +	#return (($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked');
    1.74 +	
    1.75 +	#$y = "$t<br>".(($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked')."
    1.76 +	
    1.77 +	{
    1.78 +    local( $/, *FH ) ;
    1.79 +    open( FH, "<./buy_pieces/materials2.html" ) or die "sudden flaming death\n";
    1.80 +    $y = <FH>;
    1.81 +	}
    1.82 +	
    1.83 +	@symbols = qw(PERL::ACRYLIC_CLEAR PERL::ACRYLIC_BLUE PERL::ACRYLIC_GREEN PERL::ALUMINUM_RED PERL::ALUMINUM_BLUE PERL::ALUMINUM_GREEN PERL::ALUMINUM_BLACK);
    1.84 +	
    1.85 +	for (@symbols)
    1.86 +	{
    1.87 +	$c = $_;
    1.88 +	$c =~ s/PERL:://;
    1.89 +	$c =~ tr/[A-Z]/[a-z]/;
    1.90 +	$c =~ s/^/_/;
    1.91 +	
    1.92 +	$b = '"'.$newvar.$c.'"'.(($t =~ m/$c/) ? '  CHECKED ' : '');
    1.93 +	$y =~ s/$_/$b/; 
    1.94 +	}
    1.95 +	
    1.96 +
    1.97 +	$first = shift;
    1.98 +	if ($first){  $y =~ s/display[^;]*;//g; }
    1.99 +	
   1.100 +		
   1.101 +	
   1.102 +	return $y;
   1.103 +		
   1.104 +	
   1.105 +}
   1.106 +
   1.107 +
   1.108 +
   1.109 +sub template
   1.110 +{
   1.111 +	
   1.112 +$all = shift;
   1.113 +$all =~ m/([^_]*)_(.*)/;
   1.114 +
   1.115 +$materialcolor = $2;
   1.116 +$style = $1;
   1.117 +#here is where we handle important drawing commands relating to the cards.
   1.118 +
   1.119 +
   1.120 +	
   1.121 +$r =  <<HERE;
   1.122 +<div id = "i_templates"><div class = 'ttyl'> <titletron>Select Style.</titletron></div>
   1.123 +<div id = 'stupid'>
   1.124 +
   1.125 +
   1.126 +<input TYPE="image" src = "./images/templates/big_$materialcolor.jpg" 	
   1.127 +onmouseover="pokedex('big_$materialcolor');"
   1.128 +onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
   1.129 +
   1.130 +
   1.131 + 	
   1.132 +onclick=
   1.133 +"display(['template2'], ['display']); 
   1.134 +inputbox(['template2', 'formValues'], ['inputbox']);
   1.135 +material(['template2'], ['materials']);
   1.136 +cardType(['template2'], ['currentSpec']);
   1.137 +redraw('bold');" 
   1.138 +ID="template2" NAME="template2" VALUE="big_$materialcolor">
   1.139 +<br>
   1.140 +
   1.141 +  
   1.142 +
   1.143 +<input TYPE="image" src = "./images/templates/basic_$materialcolor.jpg"
   1.144 +onmouseover="pokedex('basic_$materialcolor');" 
   1.145 +onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
   1.146 +onclick=
   1.147 +"display(['template3'], ['display']); 
   1.148 +inputbox(['template3', 'formValues'], ['inputbox']);
   1.149 +material(['template3'], ['materials']);
   1.150 +cardType(['template3'], ['currentSpec']);
   1.151 +redraw('arrow');" 
   1.152 +ID="template3" NAME="template3" VALUE="basic_$materialcolor"          ><br>
   1.153 +
   1.154 + 
   1.155 +
   1.156 +<input TYPE="image" src = "./images/templates/classic_$materialcolor.jpg"  
   1.157 +onmouseover="pokedex('classic_$materialcolor');" 
   1.158 +onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
   1.159 +onclick=
   1.160 +"display(['template1'], ['display']); 
   1.161 +inputbox(['template1', 'formValues'], ['inputbox']);
   1.162 +material(['template1'], ['materials']);
   1.163 +cardType(['template1'], ['currentSpec']);
   1.164 +redraw('classic');" 
   1.165 +ID="template1" NAME="template1" VALUE="classic_$materialcolor"    ><br>
   1.166 +
   1.167 + 
   1.168 +
   1.169 +<input TYPE="image" src = "./images/templates/lines_$materialcolor.jpg" 
   1.170 +onmouseover="pokedex('lines_$materialcolor');" 	
   1.171 +onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
   1.172 +onclick=
   1.173 +"display(['template4'], ['display']); 
   1.174 +inputbox(['template4', 'formValues'], ['inputbox']);
   1.175 +material(['template4'], ['materials']);
   1.176 +cardType(['template4'], ['currentSpec']);
   1.177 +redraw('direct');" 
   1.178 +ID="template4" NAME="template4" VALUE="lines_$materialcolor"           > 
   1.179 +
   1.180 +	</div>
   1.181 +	</div>
   1.182 +
   1.183 +HERE
   1.184 +
   1.185 +
   1.186 +%shankHash = 
   1.187 +(
   1.188 +
   1.189 +big => template2,  
   1.190 +basic => template3,
   1.191 +classic => template1,
   1.192 +lines  => template4
   1.193 +);
   1.194 +
   1.195 +$target = $shankHash{$style};
   1.196 +
   1.197 +
   1.198 +
   1.199 +
   1.200 +#$r =~ s/inputbox\(\['$target'\], \['inputbox'\]\)\;//;
   1.201 +
   1.202 +
   1.203 +
   1.204 +
   1.205 +
   1.206 +return $r;
   1.207 +}
   1.208 +
   1.209 +
   1.210 +
   1.211 +
   1.212 +sub inputbox
   1.213 +{
   1.214 +
   1.215 +#grab the type of template we'll be using <<<<
   1.216 +	$type = shift;
   1.217 +	
   1.218 +	$hashString = shift;
   1.219 +	#return $hashString;
   1.220 +	
   1.221 +	$perl_hash  = decode_json $hashString;
   1.222 +
   1.223 +	%fieldHash = %$perl_hash;
   1.224 + 
   1.225 +
   1.226 +# we have to care about both the type of template and the material and the color. these are stored in $type>>>>
   1.227 +
   1.228 +#Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template.
   1.229 +#will probaly eventually create a script to automate the generation of these files.
   1.230 +
   1.231 +
   1.232 +#take care of everythign but acrylic clear type
   1.233 +
   1.234 +  {
   1.235 +    local( $/, *FH ) ;
   1.236 +    open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";
   1.237 +    $z = <FH>;
   1.238 +  }
   1.239 +
   1.240 +
   1.241 +#every type has it's own associated paylist file the contains the things we need
   1.242 +
   1.243 +$z = <<HERE . $z;
   1.244 +<div id = "whatever" onmouseover = "pokedex(document.getElementById('currentSpec').innerHTML);">
   1.245 +HERE
   1.246 +
   1.247 +
   1.248 +
   1.249 +
   1.250 +$z = $z.'</div>';
   1.251 +
   1.252 +
   1.253 +foreach my $key ( keys %fieldHash )
   1.254 +{
   1.255 +
   1.256 +my $replace  = $fieldHash{$key};
   1.257 +
   1.258 +#id="Name" value = "PERL::NAME" 
   1.259 +
   1.260 +
   1.261 +$z =~ s/id="$key"/id="$key" value = "$replace"/g;
   1.262 +
   1.263 +
   1.264 +}
   1.265 +
   1.266 +
   1.267 +return $z;
   1.268 +
   1.269 +
   1.270 +
   1.271 +
   1.272 +
   1.273 +}
   1.274 +
   1.275 +
   1.276 +
   1.277 +
   1.278 +sub display
   1.279 +{
   1.280 +	$all = shift;
   1.281 +	
   1.282 +	
   1.283 +	#~ 
   1.284 +	#~ $t = <<HERE;
   1.285 +	#~ <image src = "./images/display/PERL::PIC.jpg" 	onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">
   1.286 +	#~ 
   1.287 +	#~ <div id = overlay>
   1.288 +#~ 
   1.289 +#~ 
   1.290 +	#~ </div>
   1.291 +	#~ 
   1.292 +#~ HERE
   1.293 +#~ 
   1.294 +#~ 
   1.295 +#~ 
   1.296 +#~ $t =~ s/PERL::PIC/$all/g;
   1.297 +
   1.298 +	$t = <<HERE;
   1.299 +	<image src = "./images/display/blank.jpg" 	
   1.300 +	onmouseover = "pokedex(document.getElementById('currentSpec').innerHTML);"
   1.301 +	>
   1.302 +	
   1.303 +	<div id = overlay>
   1.304 +
   1.305 +
   1.306 +	</div>
   1.307 +	
   1.308 +HERE
   1.309 +	
   1.310 +	return $t;
   1.311 +	
   1.312 +}
   1.313 +
   1.314 +
   1.315 +sub genBuy
   1.316 +
   1.317 +{
   1.318 +return gen("buy.html");	
   1.319 +	
   1.320 +}
   1.321 +
   1.322 +
   1.323 +sub genEcho
   1.324 +{
   1.325 +	
   1.326 +return gen("echo.html");
   1.327 +	
   1.328 +}
   1.329 +
   1.330 +
   1.331 +sub gen
   1.332 +{
   1.333 +	
   1.334 +	my $target = shift;
   1.335 +	
   1.336 +  {
   1.337 +    local( $/, *FH ) ;
   1.338 +    open( FH, "<./$target" ) or die "sudden flaming death\n";
   1.339 +    $a = <FH>;
   1.340 +   }
   1.341 +
   1.342 +  {
   1.343 +    local( $/, *FH ) ;
   1.344 +    open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";
   1.345 +    $b = <FH>;
   1.346 +   }
   1.347 +
   1.348 +  {
   1.349 +    local( $/, *FH ) ;
   1.350 +    open( FH, "<./cardDefinitions.JSON" ) or die "sudden flaming death\n";
   1.351 +    $c = <FH>;
   1.352 +   }
   1.353 +
   1.354 +$a =~s/PERL::DEFS/$c/;
   1.355 +
   1.356 +
   1.357 +
   1.358 +$a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)
   1.359 +$b = &material("void_acrylic_clear",1);
   1.360 +$a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)
   1.361 +
   1.362 +
   1.363 +
   1.364 +$b = "big_acrylic_clear";
   1.365 +$a =~ s/PERL::INITIALCARD/$b/;
   1.366 +$b = &template("big_acrylic_clear");
   1.367 +$a =~ s/PERL-REPLACE::TEMPLATES/$b/; 
   1.368 +
   1.369 +$b = &display("big_acrylic_clear");
   1.370 +$a =~ s/PERL-REPLACE::DISPLAY/$b/;
   1.371 +
   1.372 +$initials = <<HERE ;
   1.373 +{
   1.374 +"Name":"James Bond",
   1.375 +"Email":"jbond\@mi6.co.uk",
   1.376 +"Phone": "123.456.7890", 
   1.377 +"Company": "MI6",
   1.378 +"Website" : "http://jamesbond.com",
   1.379 +"Occupation" : "Secret Agent"
   1.380 +}
   1.381 +
   1.382 +HERE
   1.383 +
   1.384 +
   1.385 +
   1.386 +$b = &inputbox("big_acrylic_clear", $initials);
   1.387 +$a =~ s/PERL-REPLACE::INPUTBOX/$b/;
   1.388 +
   1.389 +$b = &pokedex('big');
   1.390 +$a =~ s/PERL-REPLACE::POKEDEX/$b/;
   1.391 +
   1.392 +
   1.393 +
   1.394 +#$b = &updateForm('fuck','12', '{}');
   1.395 +$a =~ s/PERL::INITIALVALUES/$initials/;
   1.396 +
   1.397 +
   1.398 +
   1.399 +return $a
   1.400 +
   1.401 +
   1.402 +}
   1.403 +
   1.404 +
   1.405 +
   1.406 +sub pokedex
   1.407 +{
   1.408 +
   1.409 +
   1.410 +$classic = <<HERE;
   1.411 +<h1>The Classic LaserKard.</h1>
   1.412 +Balanced and Complete.  The original LaserKard.  For those that wish to leave no stone unturned.  It's all there.
   1.413 +HERE
   1.414 +
   1.415 +$bold = <<HERE;
   1.416 +<h1>The Bold Kard.</h1>
   1.417 +Austere and Iconic.  For those that wish to leave an impression with the power of their name accompanied only by their main method of contact.  Bold, period.
   1.418 +HERE
   1.419 +
   1.420 +$arrow = <<HERE;
   1.421 +<h1>The Arrow Kard.</h1>
   1.422 +Precise and Straightforward.  For those that seek to make a statement while being clear and concise. Straight as an arrow.
   1.423 +HERE
   1.424 +
   1.425 +$direct = <<HERE;
   1.426 +<h1>The Direct Kard.</h1>
   1.427 +Thorough and Distinct.  For those that aim to demonstrate their professionalism with style.  Push the envelope.  Be Direct.
   1.428 +HERE
   1.429 +
   1.430 +
   1.431 +
   1.432 +my %megahash = 
   1.433 +(
   1.434 +
   1.435 +'big' => $bold,
   1.436 +
   1.437 +'basic' => $arrow,
   1.438 +
   1.439 +'lines' => $direct,
   1.440 +
   1.441 +'classic' => $classic,
   1.442 +
   1.443 +'big_acrylic_clear' => $bold,
   1.444 +
   1.445 +'classic_acrylic_clear' => $classic,
   1.446 +
   1.447 +'basic_acrylic_clear'  => $arrow,
   1.448 +
   1.449 +'lines_acrylic_clear' => $direct
   1.450 +);
   1.451 +
   1.452 +
   1.453 +
   1.454 +my $key = shift;
   1.455 +
   1.456 +
   1.457 +if (!$megahash{$key}){return $key;}
   1.458 +
   1.459 +return $megahash{$key};
   1.460 +
   1.461 +
   1.462 +
   1.463 +
   1.464 +}
   1.465 +
   1.466 +
   1.467 +
   1.468 +
   1.469 +
   1.470 +
   1.471 +
   1.472 +
   1.473 +# this here function makes the paypal button go away so people know it's working!
   1.474 +sub vanish
   1.475 +{
   1.476 +return "";
   1.477 +
   1.478 +
   1.479 +}
   1.480 +
   1.481 +1;
   1.482 +
   1.483 +