Mercurial > laserkard
view buy.pl @ 22:3298256dd459 laserkard
[svn r23] did much cosmetic work.
author | rlm |
---|---|
date | Sun, 03 Jan 2010 03:36:21 -0500 |
parents | 896afe03bc67 |
children | 707d202f58b1 |
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);26 my $pjx = CGI::Ajax->new(%hash);27 #$pjx->JSDEBUG(1);28 #$pjx->DEBUG(1);30 print $pjx->build_html($q,\&gen); # this outputs the html for the page36 sub material{38 $newvar = shift;40 my $t = $newvar;42 $newvar =~ m/([^_]*)_/;43 $newvar = $1;45 #return (($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked');47 #$y = "$t<br>".(($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked')."49 {50 local( $/, *FH ) ;51 open( FH, "<./buy_pieces/materials2.html" ) or die "sudden flaming death\n";52 $y = <FH>;53 }55 @symbols = qw(PERL::ACRYLIC_CLEAR PERL::ACRYLIC_BLUE PERL::ACRYLIC_GREEN PERL::ALUMINUM_RED PERL::ALUMINUM_BLUE PERL::ALUMINUM_GREEN PERL::ALUMINUM_BLACK);57 for (@symbols)58 {59 $c = $_;60 $c =~ s/PERL:://;61 $c =~ tr/[A-Z]/[a-z]/;62 $c =~ s/^/_/;64 $b = '"'.$newvar.$c.'"'.(($t =~ m/$c/) ? ' CHECKED ' : '');65 $y =~ s/$_/$b/;66 }69 $first = shift;70 if ($first){ $y =~ s/display[^;]*;//g; }74 return $y;77 }81 sub template82 {84 $all = shift;85 $all =~ m/_(.*)/;87 $materialcolor = $1;90 $r = "<div id = \"i_templates\">Templates:<br>92 <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>94 <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>96 <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>98 <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\" >99 </div>101 ";103 return $r;104 }109 sub inputbox110 {112 #grab the type of template we'll be using <<<<113 $type = shift;114 # return $type;115 # we have to care about both the type of template and the material and the color. these are stored in $type>>>>117 #Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template.118 #will probaly eventually create a script to automate the generation of these files.121 #take care of everythign but acrylic clear type125 {126 local( $/, *FH ) ;127 open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";128 $z = <FH>;129 }132 #every type has it's own associated paylist file the contains the things we need134 $z = '<div id = "whatever" onmouseover='."\"pokedex([\'args__$type\'],[\'pokedex\']);\"".$z.'</div>';135 return $z;141 }150 sub display151 {152 $all = shift;156 $t ="157 <input TYPE=\"image\" src = \"./images/display/$all.jpg\" >158 ";159 return $t;161 }166 sub gen167 {168 {169 local( $/, *FH ) ;170 open( FH, "<./buy.html" ) or die "sudden flaming death\n";171 $a = <FH>;172 }174 {175 local( $/, *FH ) ;176 open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";177 $b = <FH>;178 }182 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)183 $b = &material("void_acrylic_clear",1);184 $a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)185 $b = &template("big_acrylic_clear");187 #$a =~ s/PERL-REPLACE::TEMPLATES//;188 $a =~ s/PERL-REPLACE::TEMPLATES/$b/; #comment out one or the other!190 $b = &display("big_acrylic_clear");191 $a =~ s/PERL-REPLACE::DISPLAY/$b/;193 $b = &inputbox("big_acrylic_clear");194 $a =~ s/PERL-REPLACE::INPUTBOX/$b/;197 return $a200 }204 sub pokedex205 {207 my $key = shift;209 return $key;212 }