view buy.pl @ 46:26c2b3ad21c7 laserkard

[svn r47] saving progresswww.cinemassacre.com/new/?page_id=30
author rlm
date Sun, 31 Jan 2010 12:33:33 -0500
parents 1045db9799e3
children 4431dc7d4bb5
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 }
306 {
307 local( $/, *FH ) ;
308 open( FH, "<./cardDefinitions.JSON" ) or die "sudden flaming death\n";
309 $c = <FH>;
310 }
312 $a =~s/PERL::DEFS/$c/;
316 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)
317 $b = &material("void_acrylic_clear",1);
318 $a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)
319 $b = &template("big_acrylic_clear");
325 $a =~ s/PERL-REPLACE::TEMPLATES/$b/;
327 $b = &display("big_acrylic_clear");
328 $a =~ s/PERL-REPLACE::DISPLAY/$b/;
330 $initials = <<HERE ;
331 {
332 "Name":"James Bond",
333 "Email":"jbond\@mi6.co.uk",
334 "Phone": "123.456.7890",
335 "Company": "MI6",
336 "Website" : "http://jamesbond.com",
337 "Occupation" : "Secret Agent"
338 }
340 HERE
344 $b = &inputbox("big_acrylic_clear", $initials);
345 $a =~ s/PERL-REPLACE::INPUTBOX/$b/;
347 $b = &pokedex('big');
348 $a =~ s/PERL-REPLACE::POKEDEX/$b/;
352 #$b = &updateForm('fuck','12', '{}');
353 $a =~ s/PERL::INITIALVALUES/$initials/;
357 return $a
360 }
364 sub pokedex
365 {
368 $classic = <<HERE;
369 <h1>The Classic LaserKard.</h1>
370 Balanced and Complete. The original LaserKard. For those that wish to leave no stone unturned. It's all there.
371 HERE
373 $bold = <<HERE;
374 <h1>The Bold Kard.</h1>
375 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.
376 HERE
378 $arrow = <<HERE;
379 <h1>The Arrow Kard.</h1>
380 Precise and Straightforward. For those that seek to make a statement while being clear and concise. Straight as an arrow.
381 HERE
383 $direct = <<HERE;
384 <h1>The Direct Kard.</h1>
385 Thorough and Distinct. For those that aim to demonstrate their professionalism with style. Push the envelope. Be Direct.
386 HERE
390 my %megahash =
391 (
393 'big' => $bold,
395 'basic' => $arrow,
397 'lines' => $direct,
399 'classic' => $classic,
401 'big_acrylic_clear' => $bold,
403 'classic_acrylic_clear' => $classic,
405 'basic_acrylic_clear' => $arrow,
407 'lines_acrylic_clear' => $direct
408 );
412 my $key = shift;
415 if (!$megahash{$key}){return $key;}
417 return $megahash{$key};
422 }
431 # this here function makes the paypal button go away so people know it's working!
432 sub vanish
433 {
434 return "";
437 }