view buy.pl @ 47:4431dc7d4bb5 laserkard

[svn r48] almost fixed "hover over" bug
author rlm
date Sun, 31 Jan 2010 14:21:14 -0500
parents 1045db9799e3
children 95fa4bcc5d67
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,
20 'template' => \&template,
21 'inputbox' => \&inputbox,
22 'display' => \&display,
23 'change_rules' => \&change_rules,
24 'vanish' => \&vanish,
25 'updateForm' => \&updateForm,
26 'cardType' => \&cardType
27 );
31 my $pjx = CGI::Ajax->new(%hash);
34 # this outputs the html for the page
35 print $pjx->build_html($q,\&gen,{-Cache_Control => 'no-store, no-cache, must-revalidate', -Pragma => 'no-cache'});
39 sub cardType
40 {
42 return $_[0];
44 }
48 sub updateForm
50 {
53 $key = shift;
54 $value = shift;
55 $hashString = shift;
57 $perl_hash = decode_json $hashString;
59 %fieldHash = %$perl_hash;
62 $fieldHash{$key} = $value;
63 $ref = \%fieldHash;
65 $utf8_encoded_json_text = encode_json $ref ;
66 return $utf8_encoded_json_text;
68 }
73 sub material{
75 $newvar = shift;
77 my $t = $newvar;
79 $newvar =~ m/([^_]*)_/;
80 $newvar = $1;
82 #return (($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked');
84 #$y = "$t<br>".(($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked')."
86 {
87 local( $/, *FH ) ;
88 open( FH, "<./buy_pieces/materials2.html" ) or die "sudden flaming death\n";
89 $y = <FH>;
90 }
92 @symbols = qw(PERL::ACRYLIC_CLEAR PERL::ACRYLIC_BLUE PERL::ACRYLIC_GREEN PERL::ALUMINUM_RED PERL::ALUMINUM_BLUE PERL::ALUMINUM_GREEN PERL::ALUMINUM_BLACK);
94 for (@symbols)
95 {
96 $c = $_;
97 $c =~ s/PERL:://;
98 $c =~ tr/[A-Z]/[a-z]/;
99 $c =~ s/^/_/;
101 $b = '"'.$newvar.$c.'"'.(($t =~ m/$c/) ? ' CHECKED ' : '');
102 $y =~ s/$_/$b/;
103 }
106 $first = shift;
107 if ($first){ $y =~ s/display[^;]*;//g; }
111 return $y;
114 }
118 sub template
119 {
121 $all = shift;
122 $all =~ m/([^_]*)_(.*)/;
124 $materialcolor = $2;
125 $style = $1;
126 #here is where we handle important drawing commands relating to the cards.
130 $r = <<HERE;
131 <div id = "i_templates"><div class = 'ttyl'> <titletron>Select Style.</titletron></div>
132 <div id = 'stupid'>
135 <input TYPE="image" src = "./images/templates/big_$materialcolor.jpg"
136 onmouseover="pokedex('big_$materialcolor');"
137 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
141 onclick=
142 "display(['template2'], ['display']);
143 inputbox(['template2', 'formValues'], ['inputbox']);
144 material(['template2'], ['materials']);
145 cardType(['template2'], ['currentSpec']);
146 redraw('bold');"
147 ID="template2" NAME="template2" VALUE="big_$materialcolor">
148 <br>
152 <input TYPE="image" src = "./images/templates/basic_$materialcolor.jpg"
153 onmouseover="pokedex('basic_$materialcolor');"
154 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
155 onclick=
156 "display(['template3'], ['display']);
157 inputbox(['template3', 'formValues'], ['inputbox']);
158 material(['template3'], ['materials']);
159 cardType(['template3'], ['currentSpec']);
160 redraw('arrow');"
161 ID="template3" NAME="template3" VALUE="basic_$materialcolor" ><br>
165 <input TYPE="image" src = "./images/templates/classic_$materialcolor.jpg"
166 onmouseover="pokedex('classic_$materialcolor');"
167 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
168 onclick=
169 "display(['template1'], ['display']);
170 inputbox(['template1', 'formValues'], ['inputbox']);
171 material(['template1'], ['materials']);
172 cardType(['template1'], ['currentSpec']);
173 redraw('classic');"
174 ID="template1" NAME="template1" VALUE="classic_$materialcolor" ><br>
178 <input TYPE="image" src = "./images/templates/lines_$materialcolor.jpg"
179 onmouseover="pokedex('lines_$materialcolor');"
180 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
181 onclick=
182 "display(['template4'], ['display']);
183 inputbox(['template4', 'formValues'], ['inputbox']);
184 material(['template4'], ['materials']);
185 cardType(['template4'], ['currentSpec']);
186 redraw('direct');"
187 ID="template4" NAME="template4" VALUE="lines_$materialcolor" >
189 </div>
190 </div>
192 HERE
195 %shankHash =
196 (
198 big => template2,
199 basic => template3,
200 classic => template1,
201 lines => template4
202 );
204 $target = $shankHash{$style};
209 #$r =~ s/inputbox\(\['$target'\], \['inputbox'\]\)\;//;
215 return $r;
216 }
221 sub inputbox
222 {
224 #grab the type of template we'll be using <<<<
225 $type = shift;
227 $hashString = shift;
228 #return $hashString;
230 $perl_hash = decode_json $hashString;
232 %fieldHash = %$perl_hash;
235 # we have to care about both the type of template and the material and the color. these are stored in $type>>>>
237 #Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template.
238 #will probaly eventually create a script to automate the generation of these files.
241 #take care of everythign but acrylic clear type
243 {
244 local( $/, *FH ) ;
245 open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";
246 $z = <FH>;
247 }
250 #every type has it's own associated paylist file the contains the things we need
252 $z = <<HERE . $z;
253 <div id = "whatever" onmouseover = "pokedex(document.getElementById('currentSpec').innerHTML);">
254 HERE
259 $z = $z.'</div>';
262 foreach my $key ( keys %fieldHash )
263 {
265 my $replace = $fieldHash{$key};
267 #id="Name" value = "PERL::NAME"
270 $z =~ s/id="$key"/id="$key" value = "$replace"/g;
273 }
276 return $z;
282 }
287 sub display
288 {
289 $all = shift;
292 #~
293 #~ $t = <<HERE;
294 #~ <image src = "./images/display/PERL::PIC.jpg" onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">
295 #~
296 #~ <div id = overlay>
297 #~
298 #~
299 #~ </div>
300 #~
301 #~ HERE
302 #~
303 #~
304 #~
305 #~ $t =~ s/PERL::PIC/$all/g;
307 $t = <<HERE;
308 <image src = "./images/display/blank.jpg"
309 onmouseover = "pokedex(document.getElementById('currentSpec').innerHTML);"
310 >
312 <div id = overlay>
315 </div>
317 HERE
319 return $t;
321 }
326 sub gen
327 {
328 {
329 local( $/, *FH ) ;
330 open( FH, "<./buy.html" ) or die "sudden flaming death\n";
331 $a = <FH>;
332 }
334 {
335 local( $/, *FH ) ;
336 open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";
337 $b = <FH>;
338 }
340 {
341 local( $/, *FH ) ;
342 open( FH, "<./cardDefinitions.JSON" ) or die "sudden flaming death\n";
343 $c = <FH>;
344 }
346 $a =~s/PERL::DEFS/$c/;
350 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)
351 $b = &material("void_acrylic_clear",1);
352 $a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)
356 $b = "big_acrylic_clear";
357 $a =~ s/PERL::INITIALCARD/$b/;
358 $b = &template("big_acrylic_clear");
359 $a =~ s/PERL-REPLACE::TEMPLATES/$b/;
361 $b = &display("big_acrylic_clear");
362 $a =~ s/PERL-REPLACE::DISPLAY/$b/;
364 $initials = <<HERE ;
365 {
366 "Name":"James Bond",
367 "Email":"jbond\@mi6.co.uk",
368 "Phone": "123.456.7890",
369 "Company": "MI6",
370 "Website" : "http://jamesbond.com",
371 "Occupation" : "Secret Agent"
372 }
374 HERE
378 $b = &inputbox("big_acrylic_clear", $initials);
379 $a =~ s/PERL-REPLACE::INPUTBOX/$b/;
381 $b = &pokedex('big');
382 $a =~ s/PERL-REPLACE::POKEDEX/$b/;
386 #$b = &updateForm('fuck','12', '{}');
387 $a =~ s/PERL::INITIALVALUES/$initials/;
391 return $a
394 }
398 sub pokedex
399 {
402 $classic = <<HERE;
403 <h1>The Classic LaserKard.</h1>
404 Balanced and Complete. The original LaserKard. For those that wish to leave no stone unturned. It's all there.
405 HERE
407 $bold = <<HERE;
408 <h1>The Bold Kard.</h1>
409 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.
410 HERE
412 $arrow = <<HERE;
413 <h1>The Arrow Kard.</h1>
414 Precise and Straightforward. For those that seek to make a statement while being clear and concise. Straight as an arrow.
415 HERE
417 $direct = <<HERE;
418 <h1>The Direct Kard.</h1>
419 Thorough and Distinct. For those that aim to demonstrate their professionalism with style. Push the envelope. Be Direct.
420 HERE
424 my %megahash =
425 (
427 'big' => $bold,
429 'basic' => $arrow,
431 'lines' => $direct,
433 'classic' => $classic,
435 'big_acrylic_clear' => $bold,
437 'classic_acrylic_clear' => $classic,
439 'basic_acrylic_clear' => $arrow,
441 'lines_acrylic_clear' => $direct
442 );
446 my $key = shift;
449 if (!$megahash{$key}){return $key;}
451 return $megahash{$key};
456 }
465 # this here function makes the paypal button go away so people know it's working!
466 sub vanish
467 {
468 return "";
471 }