view buy.pl @ 37:021a9ab1ed5b laserkard

[svn r38] added echo.pl, a test program for the backend of the website
author rlm
date Sun, 24 Jan 2010 09:37:47 -0500
parents 0deeb2d5d1db
children 1ac1409ea68c
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 = <<HERE;
93 <div id = "i_templates"><div class = 'ttyl'> <titletron>Select Style.</titletron></div>
94 <div id = 'stupid'>
95 <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>
97 <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>
99 <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>
101 <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" >
102 </div>
103 </div>
105 HERE
108 return $r;
109 }
114 sub inputbox
115 {
117 #grab the type of template we'll be using <<<<
118 $type = shift;
119 # return $type;
120 # we have to care about both the type of template and the material and the color. these are stored in $type>>>>
122 #Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template.
123 #will probaly eventually create a script to automate the generation of these files.
126 #take care of everythign but acrylic clear type
130 {
131 local( $/, *FH ) ;
132 open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";
133 $z = <FH>;
134 }
137 #every type has it's own associated paylist file the contains the things we need
139 $z = '<div id = "whatever" onmouseover='."\"pokedex([\'args__$type\'],[\'pokedex\']);\">".$z.'</div>';
140 return $z;
146 }
155 sub display
156 {
157 $all = shift;
161 $t = <<HERE;
162 <image src = "./images/display/PERL::PIC.jpg" onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">
164 <div id = overlay>
167 </div>
169 HERE
173 $t =~ s/PERL::PIC/$all/g;
177 return $t;
179 }
184 sub gen
185 {
186 {
187 local( $/, *FH ) ;
188 open( FH, "<./buy.html" ) or die "sudden flaming death\n";
189 $a = <FH>;
190 }
192 {
193 local( $/, *FH ) ;
194 open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";
195 $b = <FH>;
196 }
200 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)
201 $b = &material("void_acrylic_clear",1);
202 $a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)
203 $b = &template("big_acrylic_clear");
205 #$a =~ s/PERL-REPLACE::TEMPLATES//;
206 $a =~ s/PERL-REPLACE::TEMPLATES/$b/; #comment out one or the other!
208 $b = &display("big_acrylic_clear");
209 $a =~ s/PERL-REPLACE::DISPLAY/$b/;
211 $b = &inputbox("big_acrylic_clear");
212 $a =~ s/PERL-REPLACE::INPUTBOX/$b/;
214 $b = &pokedex('big');
215 $a =~ s/PERL-REPLACE::POKEDEX/$b/;
218 return $a
221 }
225 sub pokedex
226 {
229 $classic = <<HERE;
230 <h1>The Classic LaserKard.</h1>
231 Balanced and Complete. The original LaserKard. For those that wish to leave no stone unturned. It's all there.
232 HERE
234 $bold = <<HERE;
235 <h1>The Bold Kard.</h1>
236 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.
237 HERE
239 $arrow = <<HERE;
240 <h1>The Arrow Kard.</h1>
241 Precise and Straightforward. For those that seek to make a statement while being clear and concise. Straight as an arrow.
242 HERE
244 $direct = <<HERE;
245 <h1>The Direct Kard.</h1>
246 Thorough and Distinct. For those that aim to demonstrate their professionalism with style. Push the envelope. Be Direct.
247 HERE
251 my %megahash =
252 (
254 'big' => $bold,
256 'basic' => $arrow,
258 'lines' => $direct,
260 'classic' => $classic,
262 'big_acrylic_clear' => $bold,
264 'classic_acrylic_clear' => $classic,
266 'basic_acrylic_clear' => $arrow,
268 'lines_acrylic_clear' => $direct
269 );
273 my $key = shift;
276 if (!$megahash{$key}){return $key;}
278 return $megahash{$key};
283 }
292 # this here function makes the paypal button go away so people know it's working!
293 sub vanish
294 {
295 return "";
298 }