Mercurial > laserkard
view buy.pl @ 40:1ac1409ea68c laserkard
[svn r41] implemented dynamic text.
author | rlm |
---|---|
date | Mon, 25 Jan 2010 03:42:08 -0500 |
parents | 021a9ab1ed5b |
children | ef8615de8a9c |
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;11 my $q = new CGI;15 my %hash = (17 'material' => \&material,18 'pokedex' => \&pokedex,19 'template' => \&template,20 'inputbox' => \&inputbox,21 'display' => \&display,22 'change_rules' => \&change_rules,23 'vanish' => \&vanish24 );28 my $pjx = CGI::Ajax->new(%hash);29 #$pjx->JSDEBUG(1);30 #$pjx->DEBUG(1);32 print $pjx->build_html($q,\&gen,{-Cache_Control => 'no-store, no-cache, must-revalidate', -Pragma => 'no-cache'}); # this outputs the html for the page38 sub material{40 $newvar = shift;42 my $t = $newvar;44 $newvar =~ m/([^_]*)_/;45 $newvar = $1;47 #return (($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked');49 #$y = "$t<br>".(($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked')."51 {52 local( $/, *FH ) ;53 open( FH, "<./buy_pieces/materials2.html" ) or die "sudden flaming death\n";54 $y = <FH>;55 }57 @symbols = qw(PERL::ACRYLIC_CLEAR PERL::ACRYLIC_BLUE PERL::ACRYLIC_GREEN PERL::ALUMINUM_RED PERL::ALUMINUM_BLUE PERL::ALUMINUM_GREEN PERL::ALUMINUM_BLACK);59 for (@symbols)60 {61 $c = $_;62 $c =~ s/PERL:://;63 $c =~ tr/[A-Z]/[a-z]/;64 $c =~ s/^/_/;66 $b = '"'.$newvar.$c.'"'.(($t =~ m/$c/) ? ' CHECKED ' : '');67 $y =~ s/$_/$b/;68 }71 $first = shift;72 if ($first){ $y =~ s/display[^;]*;//g; }76 return $y;79 }83 sub template84 {86 $all = shift;87 $all =~ m/([^_]*)_(.*)/;89 $materialcolor = $2;90 $style = $1;91 #here is where we handle important drawing commands relating to the cards.95 $r = <<HERE;96 <div id = "i_templates"><div class = 'ttyl'> <titletron>Select Style.</titletron></div>97 <div id = 'stupid'>100 <input TYPE="image" src = "./images/templates/big_$materialcolor.jpg" onmouseover="pokedex(['args__big'],['pokedex']);" onclick="display(['template2'], ['display']); inputbox(['template2'], ['inputbox']);material(['template2'], ['materials']);redraw('bold');" ID="template2" NAME="template2" VALUE="big_$materialcolor" > <br>104 <input TYPE="image" src = "./images/templates/basic_$materialcolor.jpg" onmouseover="pokedex(['args__basic'],['pokedex']);" onclick="display(['template3'], ['display']); inputbox(['template3'], ['inputbox']);material(['template3'], ['materials']);redraw('arrow');" ID="template3" NAME="template3" VALUE="basic_$materialcolor" ><br>108 <input TYPE="image" src = "./images/templates/classic_$materialcolor.jpg" onmouseover="pokedex(['args__classic'],['pokedex']);" onclick="display(['template1'], ['display']); inputbox(['template1'], ['inputbox']);material(['template1'], ['materials']);redraw('classic');" ID="template1" NAME="template1" VALUE="classic_$materialcolor" ><br>112 <input TYPE="image" src = "./images/templates/lines_$materialcolor.jpg" onmouseover="pokedex(['args__lines'],['pokedex']);" onclick="display(['template4'], ['display']); inputbox(['template4'], ['inputbox']);material(['template4'], ['materials']);redraw('direct');" ID="template4" NAME="template4" VALUE="lines_$materialcolor" >114 </div>115 </div>117 HERE120 %shankHash =121 (123 big => template2,124 basic => template3,125 classic => template1,126 lines => template4127 );129 $target = $shankHash{$style};134 #$r =~ s/inputbox\(\['$target'\], \['inputbox'\]\)\;//;140 return $r;141 }146 sub inputbox147 {149 #grab the type of template we'll be using <<<<150 $type = shift;151 # return $type;152 # we have to care about both the type of template and the material and the color. these are stored in $type>>>>154 #Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template.155 #will probaly eventually create a script to automate the generation of these files.158 #take care of everythign but acrylic clear type162 {163 local( $/, *FH ) ;164 open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";165 $z = <FH>;166 }169 #every type has it's own associated paylist file the contains the things we need171 $z = '<div id = "whatever" onmouseover='."\"pokedex([\'args__$type\'],[\'pokedex\']);\">".$z.'</div>';172 return $z;178 }187 sub display188 {189 $all = shift;192 #~193 #~ $t = <<HERE;194 #~ <image src = "./images/display/PERL::PIC.jpg" onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">195 #~196 #~ <div id = overlay>197 #~198 #~199 #~ </div>200 #~201 #~ HERE202 #~203 #~204 #~205 #~ $t =~ s/PERL::PIC/$all/g;207 $t = <<HERE;208 <image src = "./images/display/blank.jpg" onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">210 <div id = overlay>213 </div>215 HERE217 return $t;219 }224 sub gen225 {226 {227 local( $/, *FH ) ;228 open( FH, "<./buy.html" ) or die "sudden flaming death\n";229 $a = <FH>;230 }232 {233 local( $/, *FH ) ;234 open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";235 $b = <FH>;236 }242 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)243 $b = &material("void_acrylic_clear",1);244 $a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)245 $b = &template("big_acrylic_clear");248 $a =~ s/PERL-REPLACE::TEMPLATES/$b/;250 $b = &display("big_acrylic_clear");251 $a =~ s/PERL-REPLACE::DISPLAY/$b/;253 $b = &inputbox("big_acrylic_clear");254 $a =~ s/PERL-REPLACE::INPUTBOX/$b/;256 $b = &pokedex('big');257 $a =~ s/PERL-REPLACE::POKEDEX/$b/;260 return $a263 }267 sub pokedex268 {271 $classic = <<HERE;272 <h1>The Classic LaserKard.</h1>273 Balanced and Complete. The original LaserKard. For those that wish to leave no stone unturned. It's all there.274 HERE276 $bold = <<HERE;277 <h1>The Bold Kard.</h1>278 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.279 HERE281 $arrow = <<HERE;282 <h1>The Arrow Kard.</h1>283 Precise and Straightforward. For those that seek to make a statement while being clear and concise. Straight as an arrow.284 HERE286 $direct = <<HERE;287 <h1>The Direct Kard.</h1>288 Thorough and Distinct. For those that aim to demonstrate their professionalism with style. Push the envelope. Be Direct.289 HERE293 my %megahash =294 (296 'big' => $bold,298 'basic' => $arrow,300 'lines' => $direct,302 'classic' => $classic,304 'big_acrylic_clear' => $bold,306 'classic_acrylic_clear' => $classic,308 'basic_acrylic_clear' => $arrow,310 'lines_acrylic_clear' => $direct311 );315 my $key = shift;318 if (!$megahash{$key}){return $key;}320 return $megahash{$key};325 }334 # this here function makes the paypal button go away so people know it's working!335 sub vanish336 {337 return "";340 }