view buy.pl @ 32:0deeb2d5d1db laserkard

[svn r33] modifications with Kevin on jan 18.
author rlm
date Mon, 18 Jan 2010 00:19:17 -0500
parents 7742910e0479
children 021a9ab1ed5b
line wrap: on
line source
1 #!/usr/bin/perl
4 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' => \&vanish
24 );
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 page
38 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 template
84 {
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 inputbox
113 {
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 type
128 {
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 need
137 $z = '<div id = "whatever" onmouseover='."\"pokedex([\'args__$type\'],[\'pokedex\']);\">".$z.'</div>';
138 return $z;
144 }
153 sub display
154 {
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 HERE
171 $t =~ s/PERL::PIC/$all/g;
175 return $t;
177 }
182 sub gen
183 {
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 $a
219 }
223 sub pokedex
224 {
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 HERE
232 $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 HERE
237 $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 HERE
242 $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 HERE
249 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' => $direct
267 );
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 vanish
292 {
293 return "";
296 }