view buy.pl @ 40:1ac1409ea68c laserkard

[svn r41] implemented dynamic text.
author rlm
date Mon, 25 Jan 2010 03:42:08 -0500
parents 021a9ab1ed5b
children ef8615de8a9c
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 = $2;
90 $style = $1;
91 #here is where we handle important drawing commands relating to the cards.
95 $r = <<HERE;
96 <div id = "i_templates"><div class = 'ttyl'> <titletron>Select Style.</titletron></div>
97 <div id = 'stupid'>
100 <input TYPE="image" src = "./images/templates/big_$materialcolor.jpg" onmouseover="pokedex(['args__big'],['pokedex']);" onclick="display(['template2'], ['display']); inputbox(['template2'], ['inputbox']);material(['template2'], ['materials']);redraw('bold');" ID="template2" NAME="template2" VALUE="big_$materialcolor" > <br>
104 <input TYPE="image" src = "./images/templates/basic_$materialcolor.jpg" onmouseover="pokedex(['args__basic'],['pokedex']);" onclick="display(['template3'], ['display']); inputbox(['template3'], ['inputbox']);material(['template3'], ['materials']);redraw('arrow');" ID="template3" NAME="template3" VALUE="basic_$materialcolor" ><br>
108 <input TYPE="image" src = "./images/templates/classic_$materialcolor.jpg" onmouseover="pokedex(['args__classic'],['pokedex']);" onclick="display(['template1'], ['display']); inputbox(['template1'], ['inputbox']);material(['template1'], ['materials']);redraw('classic');" ID="template1" NAME="template1" VALUE="classic_$materialcolor" ><br>
112 <input TYPE="image" src = "./images/templates/lines_$materialcolor.jpg" onmouseover="pokedex(['args__lines'],['pokedex']);" onclick="display(['template4'], ['display']); inputbox(['template4'], ['inputbox']);material(['template4'], ['materials']);redraw('direct');" ID="template4" NAME="template4" VALUE="lines_$materialcolor" >
114 </div>
115 </div>
117 HERE
120 %shankHash =
121 (
123 big => template2,
124 basic => template3,
125 classic => template1,
126 lines => template4
127 );
129 $target = $shankHash{$style};
134 #$r =~ s/inputbox\(\['$target'\], \['inputbox'\]\)\;//;
140 return $r;
141 }
146 sub inputbox
147 {
149 #grab the type of template we'll be using <<<<
150 $type = shift;
151 # return $type;
152 # we have to care about both the type of template and the material and the color. these are stored in $type>>>>
154 #Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template.
155 #will probaly eventually create a script to automate the generation of these files.
158 #take care of everythign but acrylic clear type
162 {
163 local( $/, *FH ) ;
164 open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";
165 $z = <FH>;
166 }
169 #every type has it's own associated paylist file the contains the things we need
171 $z = '<div id = "whatever" onmouseover='."\"pokedex([\'args__$type\'],[\'pokedex\']);\">".$z.'</div>';
172 return $z;
178 }
187 sub display
188 {
189 $all = shift;
192 #~
193 #~ $t = <<HERE;
194 #~ <image src = "./images/display/PERL::PIC.jpg" onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">
195 #~
196 #~ <div id = overlay>
197 #~
198 #~
199 #~ </div>
200 #~
201 #~ HERE
202 #~
203 #~
204 #~
205 #~ $t =~ s/PERL::PIC/$all/g;
207 $t = <<HERE;
208 <image src = "./images/display/blank.jpg" onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">
210 <div id = overlay>
213 </div>
215 HERE
217 return $t;
219 }
224 sub gen
225 {
226 {
227 local( $/, *FH ) ;
228 open( FH, "<./buy.html" ) or die "sudden flaming death\n";
229 $a = <FH>;
230 }
232 {
233 local( $/, *FH ) ;
234 open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";
235 $b = <FH>;
236 }
242 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)
243 $b = &material("void_acrylic_clear",1);
244 $a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)
245 $b = &template("big_acrylic_clear");
248 $a =~ s/PERL-REPLACE::TEMPLATES/$b/;
250 $b = &display("big_acrylic_clear");
251 $a =~ s/PERL-REPLACE::DISPLAY/$b/;
253 $b = &inputbox("big_acrylic_clear");
254 $a =~ s/PERL-REPLACE::INPUTBOX/$b/;
256 $b = &pokedex('big');
257 $a =~ s/PERL-REPLACE::POKEDEX/$b/;
260 return $a
263 }
267 sub pokedex
268 {
271 $classic = <<HERE;
272 <h1>The Classic LaserKard.</h1>
273 Balanced and Complete. The original LaserKard. For those that wish to leave no stone unturned. It's all there.
274 HERE
276 $bold = <<HERE;
277 <h1>The Bold Kard.</h1>
278 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.
279 HERE
281 $arrow = <<HERE;
282 <h1>The Arrow Kard.</h1>
283 Precise and Straightforward. For those that seek to make a statement while being clear and concise. Straight as an arrow.
284 HERE
286 $direct = <<HERE;
287 <h1>The Direct Kard.</h1>
288 Thorough and Distinct. For those that aim to demonstrate their professionalism with style. Push the envelope. Be Direct.
289 HERE
293 my %megahash =
294 (
296 'big' => $bold,
298 'basic' => $arrow,
300 'lines' => $direct,
302 'classic' => $classic,
304 'big_acrylic_clear' => $bold,
306 'classic_acrylic_clear' => $classic,
308 'basic_acrylic_clear' => $arrow,
310 'lines_acrylic_clear' => $direct
311 );
315 my $key = shift;
318 if (!$megahash{$key}){return $key;}
320 return $megahash{$key};
325 }
334 # this here function makes the paypal button go away so people know it's working!
335 sub vanish
336 {
337 return "";
340 }