Mercurial > laserkard
view buy.pl @ 36:bb048e29406b laserkard
[svn r37] added FAQ
author | rlm |
---|---|
date | Mon, 18 Jan 2010 15:52:33 -0500 |
parents | 0deeb2d5d1db |
children | 021a9ab1ed5b |
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 = $1;92 $r = "<div id = \"i_templates\"><div class = 'ttyl'> <titletron>Select Style.</titletron></div>93 <div id = 'stupid'>94 <input TYPE=\"image\" src = \"./images/templates/big_$materialcolor.jpg\" onmouseover=\"pokedex([\'args__big\'],[\'pokedex\']);\" onclick=\"display([\'template2\'], [\'display\']); inputbox([\'template2\'], [\'inputbox\']);material([\'template2\'], [\'materials\']);\" ID=\"template2\" NAME=\"template2\" VALUE=\"big_$materialcolor\" > <br>96 <input TYPE=\"image\" src = \"./images/templates/basic_$materialcolor.jpg\" onmouseover=\"pokedex([\'args__basic\'],['pokedex\']);\" onclick=\"display([\'template3\'], [\'display\']); inputbox([\'template3\'], [\'inputbox\']);material([\'template3\'], [\'materials\']);\" ID=\"template3\" NAME=\"template3\" VALUE=\"basic_$materialcolor\" ><br>98 <input TYPE=\"image\" src = \"./images/templates/classic_$materialcolor.jpg\" onmouseover=\"pokedex([\'args__classic\'],[\'pokedex\']);\" onclick=\"display([\'template1\'], [\'display\']); inputbox([\'template1\'], [\'inputbox\']);material([\'template1\'], [\'materials\']);\" ID=\"template1\" NAME=\"template1\" VALUE=\"classic_$materialcolor\" ><br>100 <input TYPE=\"image\" src = \"./images/templates/lines_$materialcolor.jpg\" onmouseover=\"pokedex([\'args__lines\'],[\'pokedex\']);\" onclick=\"display([\'template4\'], [\'display\']); inputbox([\'template4\'], [\'inputbox\']);material([\'template4\'], [\'materials\']);\" ID=\"template4\" NAME=\"template4\" VALUE=\"lines_$materialcolor\" >101 </div>102 </div>104 ";106 return $r;107 }112 sub inputbox113 {115 #grab the type of template we'll be using <<<<116 $type = shift;117 # return $type;118 # we have to care about both the type of template and the material and the color. these are stored in $type>>>>120 #Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template.121 #will probaly eventually create a script to automate the generation of these files.124 #take care of everythign but acrylic clear type128 {129 local( $/, *FH ) ;130 open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";131 $z = <FH>;132 }135 #every type has it's own associated paylist file the contains the things we need137 $z = '<div id = "whatever" onmouseover='."\"pokedex([\'args__$type\'],[\'pokedex\']);\">".$z.'</div>';138 return $z;144 }153 sub display154 {155 $all = shift;159 $t = <<HERE;160 <image src = "./images/display/PERL::PIC.jpg" onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">162 <div id = overlay>165 </div>167 HERE171 $t =~ s/PERL::PIC/$all/g;175 return $t;177 }182 sub gen183 {184 {185 local( $/, *FH ) ;186 open( FH, "<./buy.html" ) or die "sudden flaming death\n";187 $a = <FH>;188 }190 {191 local( $/, *FH ) ;192 open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";193 $b = <FH>;194 }198 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)199 $b = &material("void_acrylic_clear",1);200 $a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)201 $b = &template("big_acrylic_clear");203 #$a =~ s/PERL-REPLACE::TEMPLATES//;204 $a =~ s/PERL-REPLACE::TEMPLATES/$b/; #comment out one or the other!206 $b = &display("big_acrylic_clear");207 $a =~ s/PERL-REPLACE::DISPLAY/$b/;209 $b = &inputbox("big_acrylic_clear");210 $a =~ s/PERL-REPLACE::INPUTBOX/$b/;212 $b = &pokedex('big');213 $a =~ s/PERL-REPLACE::POKEDEX/$b/;216 return $a219 }223 sub pokedex224 {227 $classic = <<HERE;228 <h1>The Classic LaserKard.</h1>229 Balanced and Complete. The original LaserKard. For those that wish to leave no stone unturned. It's all there.230 HERE232 $bold = <<HERE;233 <h1>The Bold Kard.</h1>234 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.235 HERE237 $arrow = <<HERE;238 <h1>The Arrow Kard.</h1>239 Precise and Straightforward. For those that seek to make a statement while being clear and concise. Straight as an arrow.240 HERE242 $direct = <<HERE;243 <h1>The Direct Kard.</h1>244 Thorough and Distinct. For those that aim to demonstrate their professionalism with style. Push the envelope. Be Direct.245 HERE249 my %megahash =250 (252 'big' => $bold,254 'basic' => $arrow,256 'lines' => $direct,258 'classic' => $classic,260 'big_acrylic_clear' => $bold,262 'classic_acrylic_clear' => $classic,264 'basic_acrylic_clear' => $arrow,266 'lines_acrylic_clear' => $direct267 );271 my $key = shift;274 if (!$megahash{$key}){return $key;}276 return $megahash{$key};281 }290 # this here function makes the paypal button go away so people know it's working!291 sub vanish292 {293 return "";296 }