Mercurial > laserkard
view buy.pl @ 48:b2a11435a89b laserkard
[svn r49] implemented resizing text :)
author | rlm |
---|---|
date | Sun, 31 Jan 2010 20:26:16 -0500 |
parents | 4431dc7d4bb5 |
children | 95fa4bcc5d67 |
line wrap: on
line source
1 #!/usr/bin/perl4 use List::Util qw(first max maxstr min minstr reduce shuffle sum);5 use Storable;6 use CGI::Ajax;7 use CGI;8 use JSON;12 my $q = new CGI;16 my %hash = (18 'material' => \&material,20 'template' => \&template,21 'inputbox' => \&inputbox,22 'display' => \&display,23 'change_rules' => \&change_rules,24 'vanish' => \&vanish,25 'updateForm' => \&updateForm,26 'cardType' => \&cardType27 );31 my $pjx = CGI::Ajax->new(%hash);34 # this outputs the html for the page35 print $pjx->build_html($q,\&gen,{-Cache_Control => 'no-store, no-cache, must-revalidate', -Pragma => 'no-cache'});39 sub cardType40 {42 return $_[0];44 }48 sub updateForm50 {53 $key = shift;54 $value = shift;55 $hashString = shift;57 $perl_hash = decode_json $hashString;59 %fieldHash = %$perl_hash;62 $fieldHash{$key} = $value;63 $ref = \%fieldHash;65 $utf8_encoded_json_text = encode_json $ref ;66 return $utf8_encoded_json_text;68 }73 sub material{75 $newvar = shift;77 my $t = $newvar;79 $newvar =~ m/([^_]*)_/;80 $newvar = $1;82 #return (($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked');84 #$y = "$t<br>".(($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked')."86 {87 local( $/, *FH ) ;88 open( FH, "<./buy_pieces/materials2.html" ) or die "sudden flaming death\n";89 $y = <FH>;90 }92 @symbols = qw(PERL::ACRYLIC_CLEAR PERL::ACRYLIC_BLUE PERL::ACRYLIC_GREEN PERL::ALUMINUM_RED PERL::ALUMINUM_BLUE PERL::ALUMINUM_GREEN PERL::ALUMINUM_BLACK);94 for (@symbols)95 {96 $c = $_;97 $c =~ s/PERL:://;98 $c =~ tr/[A-Z]/[a-z]/;99 $c =~ s/^/_/;101 $b = '"'.$newvar.$c.'"'.(($t =~ m/$c/) ? ' CHECKED ' : '');102 $y =~ s/$_/$b/;103 }106 $first = shift;107 if ($first){ $y =~ s/display[^;]*;//g; }111 return $y;114 }118 sub template119 {121 $all = shift;122 $all =~ m/([^_]*)_(.*)/;124 $materialcolor = $2;125 $style = $1;126 #here is where we handle important drawing commands relating to the cards.130 $r = <<HERE;131 <div id = "i_templates"><div class = 'ttyl'> <titletron>Select Style.</titletron></div>132 <div id = 'stupid'>135 <input TYPE="image" src = "./images/templates/big_$materialcolor.jpg"136 onmouseover="pokedex('big_$materialcolor');"137 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"141 onclick=142 "display(['template2'], ['display']);143 inputbox(['template2', 'formValues'], ['inputbox']);144 material(['template2'], ['materials']);145 cardType(['template2'], ['currentSpec']);146 redraw('bold');"147 ID="template2" NAME="template2" VALUE="big_$materialcolor">148 <br>152 <input TYPE="image" src = "./images/templates/basic_$materialcolor.jpg"153 onmouseover="pokedex('basic_$materialcolor');"154 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"155 onclick=156 "display(['template3'], ['display']);157 inputbox(['template3', 'formValues'], ['inputbox']);158 material(['template3'], ['materials']);159 cardType(['template3'], ['currentSpec']);160 redraw('arrow');"161 ID="template3" NAME="template3" VALUE="basic_$materialcolor" ><br>165 <input TYPE="image" src = "./images/templates/classic_$materialcolor.jpg"166 onmouseover="pokedex('classic_$materialcolor');"167 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"168 onclick=169 "display(['template1'], ['display']);170 inputbox(['template1', 'formValues'], ['inputbox']);171 material(['template1'], ['materials']);172 cardType(['template1'], ['currentSpec']);173 redraw('classic');"174 ID="template1" NAME="template1" VALUE="classic_$materialcolor" ><br>178 <input TYPE="image" src = "./images/templates/lines_$materialcolor.jpg"179 onmouseover="pokedex('lines_$materialcolor');"180 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"181 onclick=182 "display(['template4'], ['display']);183 inputbox(['template4', 'formValues'], ['inputbox']);184 material(['template4'], ['materials']);185 cardType(['template4'], ['currentSpec']);186 redraw('direct');"187 ID="template4" NAME="template4" VALUE="lines_$materialcolor" >189 </div>190 </div>192 HERE195 %shankHash =196 (198 big => template2,199 basic => template3,200 classic => template1,201 lines => template4202 );204 $target = $shankHash{$style};209 #$r =~ s/inputbox\(\['$target'\], \['inputbox'\]\)\;//;215 return $r;216 }221 sub inputbox222 {224 #grab the type of template we'll be using <<<<225 $type = shift;227 $hashString = shift;228 #return $hashString;230 $perl_hash = decode_json $hashString;232 %fieldHash = %$perl_hash;235 # we have to care about both the type of template and the material and the color. these are stored in $type>>>>237 #Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template.238 #will probaly eventually create a script to automate the generation of these files.241 #take care of everythign but acrylic clear type243 {244 local( $/, *FH ) ;245 open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";246 $z = <FH>;247 }250 #every type has it's own associated paylist file the contains the things we need252 $z = <<HERE . $z;253 <div id = "whatever" onmouseover = "pokedex(document.getElementById('currentSpec').innerHTML);">254 HERE259 $z = $z.'</div>';262 foreach my $key ( keys %fieldHash )263 {265 my $replace = $fieldHash{$key};267 #id="Name" value = "PERL::NAME"270 $z =~ s/id="$key"/id="$key" value = "$replace"/g;273 }276 return $z;282 }287 sub display288 {289 $all = shift;292 #~293 #~ $t = <<HERE;294 #~ <image src = "./images/display/PERL::PIC.jpg" onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">295 #~296 #~ <div id = overlay>297 #~298 #~299 #~ </div>300 #~301 #~ HERE302 #~303 #~304 #~305 #~ $t =~ s/PERL::PIC/$all/g;307 $t = <<HERE;308 <image src = "./images/display/blank.jpg"309 onmouseover = "pokedex(document.getElementById('currentSpec').innerHTML);"310 >312 <div id = overlay>315 </div>317 HERE319 return $t;321 }326 sub gen327 {328 {329 local( $/, *FH ) ;330 open( FH, "<./buy.html" ) or die "sudden flaming death\n";331 $a = <FH>;332 }334 {335 local( $/, *FH ) ;336 open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";337 $b = <FH>;338 }340 {341 local( $/, *FH ) ;342 open( FH, "<./cardDefinitions.JSON" ) or die "sudden flaming death\n";343 $c = <FH>;344 }346 $a =~s/PERL::DEFS/$c/;350 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)351 $b = &material("void_acrylic_clear",1);352 $a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)356 $b = "big_acrylic_clear";357 $a =~ s/PERL::INITIALCARD/$b/;358 $b = &template("big_acrylic_clear");359 $a =~ s/PERL-REPLACE::TEMPLATES/$b/;361 $b = &display("big_acrylic_clear");362 $a =~ s/PERL-REPLACE::DISPLAY/$b/;364 $initials = <<HERE ;365 {366 "Name":"James Bond",367 "Email":"jbond\@mi6.co.uk",368 "Phone": "123.456.7890",369 "Company": "MI6",370 "Website" : "http://jamesbond.com",371 "Occupation" : "Secret Agent"372 }374 HERE378 $b = &inputbox("big_acrylic_clear", $initials);379 $a =~ s/PERL-REPLACE::INPUTBOX/$b/;381 $b = &pokedex('big');382 $a =~ s/PERL-REPLACE::POKEDEX/$b/;386 #$b = &updateForm('fuck','12', '{}');387 $a =~ s/PERL::INITIALVALUES/$initials/;391 return $a394 }398 sub pokedex399 {402 $classic = <<HERE;403 <h1>The Classic LaserKard.</h1>404 Balanced and Complete. The original LaserKard. For those that wish to leave no stone unturned. It's all there.405 HERE407 $bold = <<HERE;408 <h1>The Bold Kard.</h1>409 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.410 HERE412 $arrow = <<HERE;413 <h1>The Arrow Kard.</h1>414 Precise and Straightforward. For those that seek to make a statement while being clear and concise. Straight as an arrow.415 HERE417 $direct = <<HERE;418 <h1>The Direct Kard.</h1>419 Thorough and Distinct. For those that aim to demonstrate their professionalism with style. Push the envelope. Be Direct.420 HERE424 my %megahash =425 (427 'big' => $bold,429 'basic' => $arrow,431 'lines' => $direct,433 'classic' => $classic,435 'big_acrylic_clear' => $bold,437 'classic_acrylic_clear' => $classic,439 'basic_acrylic_clear' => $arrow,441 'lines_acrylic_clear' => $direct442 );446 my $key = shift;449 if (!$megahash{$key}){return $key;}451 return $megahash{$key};456 }465 # this here function makes the paypal button go away so people know it's working!466 sub vanish467 {468 return "";471 }