view buy.pl @ 43:329638a361cc laserkard

[svn r44] implemented redraw memory.
author rlm
date Thu, 28 Jan 2010 00:32:54 -0500
parents ef8615de8a9c
children 1045db9799e3
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;
8 use JSON;
12 my $q = new CGI;
16 my %hash = (
18 'material' => \&material,
19 'pokedex' => \&pokedex,
20 'template' => \&template,
21 'inputbox' => \&inputbox,
22 'display' => \&display,
23 'change_rules' => \&change_rules,
24 'vanish' => \&vanish,
25 'updateForm' => \&updateForm
26 );
30 my $pjx = CGI::Ajax->new(%hash);
33 # this outputs the html for the page
34 print $pjx->build_html($q,\&gen,{-Cache_Control => 'no-store, no-cache, must-revalidate', -Pragma => 'no-cache'});
38 sub updateForm
40 {
43 $key = shift;
44 $value = shift;
45 $hashString = shift;
47 $perl_hash = decode_json $hashString;
49 %fieldHash = %$perl_hash;
52 $fieldHash{$key} = $value;
53 $ref = \%fieldHash;
55 $utf8_encoded_json_text = encode_json $ref ;
56 return $utf8_encoded_json_text;
58 }
63 sub material{
65 $newvar = shift;
67 my $t = $newvar;
69 $newvar =~ m/([^_]*)_/;
70 $newvar = $1;
72 #return (($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked');
74 #$y = "$t<br>".(($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked')."
76 {
77 local( $/, *FH ) ;
78 open( FH, "<./buy_pieces/materials2.html" ) or die "sudden flaming death\n";
79 $y = <FH>;
80 }
82 @symbols = qw(PERL::ACRYLIC_CLEAR PERL::ACRYLIC_BLUE PERL::ACRYLIC_GREEN PERL::ALUMINUM_RED PERL::ALUMINUM_BLUE PERL::ALUMINUM_GREEN PERL::ALUMINUM_BLACK);
84 for (@symbols)
85 {
86 $c = $_;
87 $c =~ s/PERL:://;
88 $c =~ tr/[A-Z]/[a-z]/;
89 $c =~ s/^/_/;
91 $b = '"'.$newvar.$c.'"'.(($t =~ m/$c/) ? ' CHECKED ' : '');
92 $y =~ s/$_/$b/;
93 }
96 $first = shift;
97 if ($first){ $y =~ s/display[^;]*;//g; }
101 return $y;
104 }
108 sub template
109 {
111 $all = shift;
112 $all =~ m/([^_]*)_(.*)/;
114 $materialcolor = $2;
115 $style = $1;
116 #here is where we handle important drawing commands relating to the cards.
120 $r = <<HERE;
121 <div id = "i_templates"><div class = 'ttyl'> <titletron>Select Style.</titletron></div>
122 <div id = 'stupid'>
125 <input TYPE="image" src = "./images/templates/big_$materialcolor.jpg"
126 onmouseover="pokedex(['args__big'],['pokedex']);"
127 onclick=
128 "display(['template2'], ['display']);
129 inputbox(['template2', 'formValues'], ['inputbox']);
130 material(['template2'], ['materials']);
131 redraw('bold');" ID="template2" NAME="template2" VALUE="big_$materialcolor">
132 <br>
136 <input TYPE="image" src = "./images/templates/basic_$materialcolor.jpg"
137 onmouseover="pokedex(['args__basic'],['pokedex']);"
138 onclick=
139 "display(['template3'], ['display']);
140 inputbox(['template3', 'formValues'], ['inputbox']);
141 material(['template3'], ['materials']);
142 redraw('arrow');" ID="template3" NAME="template3" VALUE="basic_$materialcolor" ><br>
146 <input TYPE="image" src = "./images/templates/classic_$materialcolor.jpg"
147 onmouseover="pokedex(['args__classic'],['pokedex']);"
148 onclick=
149 "display(['template1'], ['display']);
150 inputbox(['template1', 'formValues'], ['inputbox']);
151 material(['template1'], ['materials']);
152 redraw('classic');" ID="template1" NAME="template1" VALUE="classic_$materialcolor" ><br>
156 <input TYPE="image" src = "./images/templates/lines_$materialcolor.jpg"
157 onmouseover="pokedex(['args__lines'],['pokedex']);"
158 onclick=
159 "display(['template4'], ['display']);
160 inputbox(['template4', 'formValues'], ['inputbox']);
161 material(['template4'], ['materials']);
162 redraw('direct');" ID="template4" NAME="template4" VALUE="lines_$materialcolor" >
164 </div>
165 </div>
167 HERE
170 %shankHash =
171 (
173 big => template2,
174 basic => template3,
175 classic => template1,
176 lines => template4
177 );
179 $target = $shankHash{$style};
184 #$r =~ s/inputbox\(\['$target'\], \['inputbox'\]\)\;//;
190 return $r;
191 }
196 sub inputbox
197 {
199 #grab the type of template we'll be using <<<<
200 $type = shift;
202 $hashString = shift;
203 #return $hashString;
205 $perl_hash = decode_json $hashString;
207 %fieldHash = %$perl_hash;
210 # we have to care about both the type of template and the material and the color. these are stored in $type>>>>
212 #Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template.
213 #will probaly eventually create a script to automate the generation of these files.
216 #take care of everythign but acrylic clear type
218 {
219 local( $/, *FH ) ;
220 open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";
221 $z = <FH>;
222 }
225 #every type has it's own associated paylist file the contains the things we need
227 $z = '<div id = "whatever" onmouseover='."\"pokedex([\'args__$type\'],[\'pokedex\']);\">".$z.'</div>';
230 foreach my $key ( keys %fieldHash )
231 {
233 my $replace = $fieldHash{$key};
235 #id="Name" value = "PERL::NAME"
238 $z =~ s/id="$key"/id="$key" value = "$replace"/g;
241 }
244 return $z;
250 }
255 sub display
256 {
257 $all = shift;
260 #~
261 #~ $t = <<HERE;
262 #~ <image src = "./images/display/PERL::PIC.jpg" onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">
263 #~
264 #~ <div id = overlay>
265 #~
266 #~
267 #~ </div>
268 #~
269 #~ HERE
270 #~
271 #~
272 #~
273 #~ $t =~ s/PERL::PIC/$all/g;
275 $t = <<HERE;
276 <image src = "./images/display/blank.jpg" onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">
278 <div id = overlay>
281 </div>
283 HERE
285 return $t;
287 }
292 sub gen
293 {
294 {
295 local( $/, *FH ) ;
296 open( FH, "<./buy.html" ) or die "sudden flaming death\n";
297 $a = <FH>;
298 }
300 {
301 local( $/, *FH ) ;
302 open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";
303 $b = <FH>;
304 }
310 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)
311 $b = &material("void_acrylic_clear",1);
312 $a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)
313 $b = &template("big_acrylic_clear");
316 $a =~ s/PERL-REPLACE::TEMPLATES/$b/;
318 $b = &display("big_acrylic_clear");
319 $a =~ s/PERL-REPLACE::DISPLAY/$b/;
321 $initials = <<HERE;
322 {"Email":"rlm\@mit.edu","Name":"Robert McIntyre"}
323 HERE
326 $b = &inputbox("big_acrylic_clear", $initials);
327 $a =~ s/PERL-REPLACE::INPUTBOX/$b/;
329 $b = &pokedex('big');
330 $a =~ s/PERL-REPLACE::POKEDEX/$b/;
334 #$b = &updateForm('fuck','12', '{}');
335 $a =~ s/PERL::INITIALVALUES/$initials/;
339 return $a
342 }
346 sub pokedex
347 {
350 $classic = <<HERE;
351 <h1>The Classic LaserKard.</h1>
352 Balanced and Complete. The original LaserKard. For those that wish to leave no stone unturned. It's all there.
353 HERE
355 $bold = <<HERE;
356 <h1>The Bold Kard.</h1>
357 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.
358 HERE
360 $arrow = <<HERE;
361 <h1>The Arrow Kard.</h1>
362 Precise and Straightforward. For those that seek to make a statement while being clear and concise. Straight as an arrow.
363 HERE
365 $direct = <<HERE;
366 <h1>The Direct Kard.</h1>
367 Thorough and Distinct. For those that aim to demonstrate their professionalism with style. Push the envelope. Be Direct.
368 HERE
372 my %megahash =
373 (
375 'big' => $bold,
377 'basic' => $arrow,
379 'lines' => $direct,
381 'classic' => $classic,
383 'big_acrylic_clear' => $bold,
385 'classic_acrylic_clear' => $classic,
387 'basic_acrylic_clear' => $arrow,
389 'lines_acrylic_clear' => $direct
390 );
394 my $key = shift;
397 if (!$megahash{$key}){return $key;}
399 return $megahash{$key};
404 }
413 # this here function makes the paypal button go away so people know it's working!
414 sub vanish
415 {
416 return "";
419 }