Mercurial > laserkard
view Laserkard.pm @ 58:9d156039944e laserkard
[svn r59] final modifacatios wqith kevin
author | rlm |
---|---|
date | Sun, 14 Mar 2010 01:51:23 -0500 |
parents | 8324f195ef36 |
children | 343dc947f999 |
line wrap: on
line source
1 package Laserkard;3 use List::Util qw(first max maxstr min minstr reduce shuffle sum);4 use Storable;5 use CGI::Ajax;6 use CGI;7 use JSON;8 use Laserkard;9 use base 'Exporter';11 our @EXPORT =12 qw(13 material14 template15 inputbox16 display17 change_rules18 vanish19 updateForm20 cardType21 );27 sub cardType28 {30 return $_[0];32 }36 sub updateForm38 {41 $key = shift;42 $value = shift;43 $hashString = shift;45 $perl_hash = decode_json $hashString;47 %fieldHash = %$perl_hash;50 $fieldHash{$key} = $value;51 $ref = \%fieldHash;53 $utf8_encoded_json_text = encode_json $ref ;54 return $utf8_encoded_json_text;56 }61 sub material{63 $newvar = shift;65 my $t = $newvar;67 $newvar =~ m/([^_]*)_/;68 $newvar = $1;70 #return (($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked');72 #$y = "$t<br>".(($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked')."74 {75 local( $/, *FH ) ;76 open( FH, "<./buy_pieces/materials2.html" ) or die "sudden flaming death\n";77 $y = <FH>;78 }80 @symbols = qw(PERL::ACRYLIC_CLEAR PERL::ACRYLIC_BLUE PERL::ACRYLIC_GREEN PERL::ALUMINUM_RED PERL::ALUMINUM_BLUE PERL::ALUMINUM_GREEN PERL::ALUMINUM_BLACK);82 for (@symbols)83 {84 $c = $_;85 $c =~ s/PERL:://;86 $c =~ tr/[A-Z]/[a-z]/;87 $c =~ s/^/_/;89 $b = '"'.$newvar.$c.'"'.(($t =~ m/$c/) ? ' CHECKED ' : '');90 $y =~ s/$_/$b/;91 }94 $first = shift;95 if ($first){ $y =~ s/display[^;]*;//g; }99 return $y;102 }106 sub template107 {109 $all = shift;110 $all =~ m/([^_]*)_(.*)/;112 $materialcolor = $2;113 $style = $1;114 #here is where we handle important drawing commands relating to the cards.118 $r = <<HERE;119 <div id = "i_templates"><div class = 'ttyl'> <titletron>Select Style.</titletron></div>120 <div id = 'stupid'>123 <input TYPE="image" src = "./images/templates/big_$materialcolor.jpg"124 onmouseover="pokedex('big_$materialcolor');"125 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"129 onclick=130 "display(['template2'], ['display']);131 inputbox(['template2', 'formValues'], ['inputbox']);132 material(['template2'], ['materials']);133 cardType(['template2'], ['currentSpec']);134 redraw('bold');"135 ID="template2" NAME="template2" VALUE="big_$materialcolor">136 <br>140 <input TYPE="image" src = "./images/templates/basic_$materialcolor.jpg"141 onmouseover="pokedex('basic_$materialcolor');"142 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"143 onclick=144 "display(['template3'], ['display']);145 inputbox(['template3', 'formValues'], ['inputbox']);146 material(['template3'], ['materials']);147 cardType(['template3'], ['currentSpec']);148 redraw('arrow');"149 ID="template3" NAME="template3" VALUE="basic_$materialcolor" ><br>153 <input TYPE="image" src = "./images/templates/classic_$materialcolor.jpg"154 onmouseover="pokedex('classic_$materialcolor');"155 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"156 onclick=157 "display(['template1'], ['display']);158 inputbox(['template1', 'formValues'], ['inputbox']);159 material(['template1'], ['materials']);160 cardType(['template1'], ['currentSpec']);161 redraw('classic');"162 ID="template1" NAME="template1" VALUE="classic_$materialcolor" ><br>166 <input TYPE="image" src = "./images/templates/lines_$materialcolor.jpg"167 onmouseover="pokedex('lines_$materialcolor');"168 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"169 onclick=170 "display(['template4'], ['display']);171 inputbox(['template4', 'formValues'], ['inputbox']);172 material(['template4'], ['materials']);173 cardType(['template4'], ['currentSpec']);174 redraw('direct');"175 ID="template4" NAME="template4" VALUE="lines_$materialcolor" >177 </div>178 </div>180 HERE183 %shankHash =184 (186 big => template2,187 basic => template3,188 classic => template1,189 lines => template4190 );192 $target = $shankHash{$style};197 #$r =~ s/inputbox\(\['$target'\], \['inputbox'\]\)\;//;203 return $r;204 }209 sub inputbox210 {212 #grab the type of template we'll be using <<<<213 $type = shift;215 $hashString = shift;216 #return $hashString;218 $perl_hash = decode_json $hashString;220 %fieldHash = %$perl_hash;223 # we have to care about both the type of template and the material and the color. these are stored in $type>>>>225 #Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template.226 #will probaly eventually create a script to automate the generation of these files.229 #take care of everythign but acrylic clear type231 {232 local( $/, *FH ) ;233 open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";234 $z = <FH>;235 }238 #every type has it's own associated paylist file the contains the things we need240 $z = <<HERE . $z;241 <div id = "whatever" onmouseover = "pokedex(document.getElementById('currentSpec').innerHTML);">242 HERE247 $z = $z.'</div>';250 foreach my $key ( keys %fieldHash )251 {253 my $replace = $fieldHash{$key};255 #id="Name" value = "PERL::NAME"258 $z =~ s/id="$key"/id="$key" value = "$replace"/g;261 }264 return $z;270 }275 sub display276 {277 $all = shift;280 #~281 #~ $t = <<HERE;282 #~ <image src = "./images/display/PERL::PIC.jpg" onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">283 #~284 #~ <div id = overlay>285 #~286 #~287 #~ </div>288 #~289 #~ HERE290 #~291 #~292 #~293 #~ $t =~ s/PERL::PIC/$all/g;295 $t = <<HERE;296 <image src = "./images/blank.jpg"297 onmouseover = "pokedex(document.getElementById('currentSpec').innerHTML);"298 >300 <div id = overlay>303 </div>305 HERE307 return $t;309 }312 sub genBuy314 {315 return gen("buy.html");317 }320 sub genEcho321 {323 return gen("echo.html");325 }328 sub gen329 {331 my $target = shift;333 {334 local( $/, *FH ) ;335 open( FH, "<./$target" ) or die "sudden flaming death\n";336 $a = <FH>;337 }339 {340 local( $/, *FH ) ;341 open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";342 $b = <FH>;343 }345 {346 local( $/, *FH ) ;347 open( FH, "<./cardDefinitions.JSON" ) or die "sudden flaming death\n";348 $c = <FH>;349 }351 $a =~s/PERL::DEFS/$c/;355 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)356 $b = &material("void_acrylic_clear",1);357 $a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)361 $b = "big_acrylic_clear";362 $a =~ s/PERL::INITIALCARD/$b/;363 $b = &template("big_acrylic_clear");364 $a =~ s/PERL-REPLACE::TEMPLATES/$b/;366 $b = &display("big_acrylic_clear");367 $a =~ s/PERL-REPLACE::DISPLAY/$b/;369 $initials = <<HERE ;370 {371 "Name":"My Name",372 "Email":"email\@example.com",373 "Phone": "(555)-555-5555",374 "Company": "Company",375 "Website" : "http://www.example.com",376 "Occupation" : "Occupation"377 }379 HERE383 $b = &inputbox("big_acrylic_clear", $initials);384 $a =~ s/PERL-REPLACE::INPUTBOX/$b/;386 $b = &pokedex('big');387 $a =~ s/PERL-REPLACE::POKEDEX/$b/;391 #$b = &updateForm('fuck','12', '{}');392 $a =~ s/PERL::INITIALVALUES/$initials/;396 return $a399 }403 sub pokedex404 {407 $classic = <<HERE;408 <h1>The Classic LaserKard.</h1>409 Balanced and Complete. The original LaserKard. For those that wish to leave no stone unturned. It's all there.410 HERE412 $bold = <<HERE;413 <h1>The Bold Kard.</h1>414 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.415 HERE417 $arrow = <<HERE;418 <h1>The Arrow Kard.</h1>419 Precise and Straightforward. For those that seek to make a statement while being clear and concise. Straight as an arrow.420 HERE422 $direct = <<HERE;423 <h1>The Direct Kard.</h1>424 Thorough and Distinct. For those that aim to demonstrate their professionalism with style. Push the envelope. Be Direct.425 HERE429 my %megahash =430 (432 'big' => $bold,434 'basic' => $arrow,436 'lines' => $direct,438 'classic' => $classic,440 'big_acrylic_clear' => $bold,442 'classic_acrylic_clear' => $classic,444 'basic_acrylic_clear' => $arrow,446 'lines_acrylic_clear' => $direct447 );451 my $key = shift;454 if (!$megahash{$key}){return $key;}456 return $megahash{$key};461 }470 # this here function makes the paypal button go away so people know it's working!471 sub vanish472 {473 return "";476 }478 1;