rlm@0
|
1 #!/usr/bin/perl
|
rlm@0
|
2
|
rlm@0
|
3
|
rlm@0
|
4 use List::Util qw(first max maxstr min minstr reduce shuffle sum);
|
rlm@0
|
5 use Storable;
|
rlm@0
|
6 use CGI::Ajax;
|
rlm@0
|
7 use CGI;
|
rlm@0
|
8
|
rlm@0
|
9
|
rlm@0
|
10
|
rlm@0
|
11 my $q = new CGI;
|
rlm@0
|
12
|
rlm@0
|
13
|
rlm@0
|
14
|
rlm@0
|
15 my %hash = (
|
rlm@0
|
16
|
rlm@0
|
17 'material' => \&material,
|
rlm@2
|
18 'pokedex' => \&pokedex,
|
rlm@0
|
19 'template' => \&template,
|
rlm@0
|
20 'inputbox' => \&inputbox,
|
rlm@0
|
21 'display' => \&display,
|
rlm@23
|
22 'change_rules' => \&change_rules,
|
rlm@23
|
23 'vanish' => \&vanish
|
rlm@23
|
24 );
|
rlm@0
|
25
|
rlm@0
|
26
|
rlm@0
|
27
|
rlm@0
|
28 my $pjx = CGI::Ajax->new(%hash);
|
rlm@0
|
29 #$pjx->JSDEBUG(1);
|
rlm@0
|
30 #$pjx->DEBUG(1);
|
rlm@0
|
31
|
rlm@28
|
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
|
rlm@0
|
33
|
rlm@0
|
34
|
rlm@0
|
35
|
rlm@0
|
36
|
rlm@0
|
37
|
rlm@0
|
38 sub material{
|
rlm@0
|
39
|
rlm@0
|
40 $newvar = shift;
|
rlm@0
|
41
|
rlm@0
|
42 my $t = $newvar;
|
rlm@0
|
43
|
rlm@0
|
44 $newvar =~ m/([^_]*)_/;
|
rlm@0
|
45 $newvar = $1;
|
rlm@0
|
46
|
rlm@0
|
47 #return (($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked');
|
rlm@0
|
48
|
rlm@0
|
49 #$y = "$t<br>".(($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked')."
|
rlm@2
|
50
|
rlm@2
|
51 {
|
rlm@2
|
52 local( $/, *FH ) ;
|
rlm@2
|
53 open( FH, "<./buy_pieces/materials2.html" ) or die "sudden flaming death\n";
|
rlm@2
|
54 $y = <FH>;
|
rlm@2
|
55 }
|
rlm@2
|
56
|
rlm@2
|
57 @symbols = qw(PERL::ACRYLIC_CLEAR PERL::ACRYLIC_BLUE PERL::ACRYLIC_GREEN PERL::ALUMINUM_RED PERL::ALUMINUM_BLUE PERL::ALUMINUM_GREEN PERL::ALUMINUM_BLACK);
|
rlm@2
|
58
|
rlm@2
|
59 for (@symbols)
|
rlm@2
|
60 {
|
rlm@2
|
61 $c = $_;
|
rlm@2
|
62 $c =~ s/PERL:://;
|
rlm@2
|
63 $c =~ tr/[A-Z]/[a-z]/;
|
rlm@2
|
64 $c =~ s/^/_/;
|
rlm@2
|
65
|
rlm@2
|
66 $b = '"'.$newvar.$c.'"'.(($t =~ m/$c/) ? ' CHECKED ' : '');
|
rlm@2
|
67 $y =~ s/$_/$b/;
|
rlm@2
|
68 }
|
rlm@2
|
69
|
rlm@2
|
70
|
rlm@2
|
71 $first = shift;
|
rlm@2
|
72 if ($first){ $y =~ s/display[^;]*;//g; }
|
rlm@2
|
73
|
rlm@0
|
74
|
rlm@0
|
75
|
rlm@0
|
76 return $y;
|
rlm@0
|
77
|
rlm@0
|
78
|
rlm@0
|
79 }
|
rlm@0
|
80
|
rlm@0
|
81
|
rlm@0
|
82
|
rlm@0
|
83 sub template
|
rlm@0
|
84 {
|
rlm@0
|
85
|
rlm@0
|
86 $all = shift;
|
rlm@0
|
87 $all =~ m/_(.*)/;
|
rlm@0
|
88
|
rlm@0
|
89 $materialcolor = $1;
|
rlm@0
|
90
|
rlm@0
|
91
|
rlm@24
|
92 $r = "<div id = \"i_templates\"><titletron>Templates</titletron><br>
|
rlm@22
|
93
|
rlm@22
|
94 <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>
|
rlm@22
|
95
|
rlm@22
|
96 <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>
|
rlm@22
|
97
|
rlm@22
|
98 <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>
|
rlm@22
|
99
|
rlm@22
|
100 <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\" >
|
rlm@5
|
101 </div>
|
rlm@0
|
102
|
rlm@0
|
103 ";
|
rlm@0
|
104
|
rlm@0
|
105 return $r;
|
rlm@0
|
106 }
|
rlm@0
|
107
|
rlm@0
|
108
|
rlm@0
|
109
|
rlm@0
|
110
|
rlm@0
|
111 sub inputbox
|
rlm@0
|
112 {
|
rlm@0
|
113
|
rlm@0
|
114 #grab the type of template we'll be using <<<<
|
rlm@0
|
115 $type = shift;
|
rlm@0
|
116 # return $type;
|
rlm@0
|
117 # we have to care about both the type of template and the material and the color. these are stored in $type>>>>
|
rlm@0
|
118
|
rlm@0
|
119 #Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template.
|
rlm@0
|
120 #will probaly eventually create a script to automate the generation of these files.
|
rlm@0
|
121
|
rlm@0
|
122
|
rlm@0
|
123 #take care of everythign but acrylic clear type
|
rlm@2
|
124
|
rlm@2
|
125
|
rlm@2
|
126
|
rlm@2
|
127 {
|
rlm@2
|
128 local( $/, *FH ) ;
|
rlm@2
|
129 open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";
|
rlm@2
|
130 $z = <FH>;
|
rlm@2
|
131 }
|
rlm@0
|
132
|
rlm@0
|
133
|
rlm@0
|
134 #every type has it's own associated paylist file the contains the things we need
|
rlm@2
|
135
|
rlm@23
|
136 $z = '<div id = "whatever" onmouseover='."\"pokedex([\'args__$type\'],[\'pokedex\']);\">".$z.'</div>';
|
rlm@2
|
137 return $z;
|
rlm@2
|
138
|
rlm@2
|
139
|
rlm@0
|
140
|
rlm@0
|
141
|
rlm@0
|
142
|
rlm@0
|
143 }
|
rlm@0
|
144
|
rlm@0
|
145
|
rlm@0
|
146
|
rlm@0
|
147
|
rlm@0
|
148
|
rlm@0
|
149
|
rlm@0
|
150
|
rlm@0
|
151
|
rlm@0
|
152 sub display
|
rlm@0
|
153 {
|
rlm@0
|
154 $all = shift;
|
rlm@0
|
155
|
rlm@0
|
156
|
rlm@0
|
157
|
rlm@24
|
158 $t = <<HERE;
|
rlm@29
|
159 <image src = "./images/display/PERL::PIC.jpg" onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">
|
rlm@29
|
160
|
rlm@29
|
161 <div id = overlay>
|
rlm@29
|
162
|
rlm@29
|
163
|
rlm@29
|
164 </div>
|
rlm@29
|
165
|
rlm@24
|
166 HERE
|
rlm@24
|
167
|
rlm@24
|
168
|
rlm@29
|
169
|
rlm@24
|
170 $t =~ s/PERL::PIC/$all/g;
|
rlm@24
|
171
|
rlm@29
|
172
|
rlm@24
|
173
|
rlm@0
|
174 return $t;
|
rlm@0
|
175
|
rlm@0
|
176 }
|
rlm@0
|
177
|
rlm@0
|
178
|
rlm@0
|
179
|
rlm@0
|
180
|
rlm@0
|
181 sub gen
|
rlm@0
|
182 {
|
rlm@0
|
183 {
|
rlm@0
|
184 local( $/, *FH ) ;
|
rlm@0
|
185 open( FH, "<./buy.html" ) or die "sudden flaming death\n";
|
rlm@0
|
186 $a = <FH>;
|
rlm@0
|
187 }
|
rlm@0
|
188
|
rlm@0
|
189 {
|
rlm@0
|
190 local( $/, *FH ) ;
|
rlm@0
|
191 open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";
|
rlm@0
|
192 $b = <FH>;
|
rlm@0
|
193 }
|
rlm@0
|
194
|
rlm@2
|
195
|
rlm@2
|
196
|
rlm@2
|
197 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)
|
rlm@2
|
198 $b = &material("void_acrylic_clear",1);
|
rlm@2
|
199 $a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)
|
rlm@22
|
200 $b = &template("big_acrylic_clear");
|
rlm@2
|
201
|
rlm@16
|
202 #$a =~ s/PERL-REPLACE::TEMPLATES//;
|
rlm@16
|
203 $a =~ s/PERL-REPLACE::TEMPLATES/$b/; #comment out one or the other!
|
rlm@2
|
204
|
rlm@22
|
205 $b = &display("big_acrylic_clear");
|
rlm@22
|
206 $a =~ s/PERL-REPLACE::DISPLAY/$b/;
|
rlm@22
|
207
|
rlm@22
|
208 $b = &inputbox("big_acrylic_clear");
|
rlm@22
|
209 $a =~ s/PERL-REPLACE::INPUTBOX/$b/;
|
rlm@2
|
210
|
rlm@24
|
211 $b = &pokedex('big');
|
rlm@24
|
212 $a =~ s/PERL-REPLACE::POKEDEX/$b/;
|
rlm@24
|
213
|
rlm@0
|
214
|
rlm@0
|
215 return $a
|
rlm@0
|
216
|
rlm@0
|
217
|
rlm@2
|
218 }
|
rlm@0
|
219
|
rlm@0
|
220
|
rlm@2
|
221
|
rlm@2
|
222 sub pokedex
|
rlm@2
|
223 {
|
rlm@2
|
224
|
rlm@24
|
225
|
rlm@24
|
226 $classic = <<HERE;
|
rlm@24
|
227 <h1>The Classic LaserKard.</h1>
|
rlm@24
|
228 Balanced and Complete. The original LaserKard. For those that wish to leave no stone unturned. It's all there.
|
rlm@24
|
229 HERE
|
rlm@24
|
230
|
rlm@24
|
231 $bold = <<HERE;
|
rlm@24
|
232 <h1>The Bold Kard.</h1>
|
rlm@24
|
233 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.
|
rlm@24
|
234 HERE
|
rlm@24
|
235
|
rlm@24
|
236 $arrow = <<HERE;
|
rlm@24
|
237 <h1>The Arrow Kard.</h1>
|
rlm@24
|
238 Precise and Straightforward. For those that seek to make a statement while being clear and concise. Straight as an arrow.
|
rlm@24
|
239 HERE
|
rlm@24
|
240
|
rlm@24
|
241 $direct = <<HERE;
|
rlm@24
|
242 <h1>The Direct Kard.</h1>
|
rlm@24
|
243 Thorough and Distinct. For those that aim to demonstrate their professionalism with style. Push the envelope. Be Direct.
|
rlm@24
|
244 HERE
|
rlm@24
|
245
|
rlm@24
|
246
|
rlm@24
|
247
|
rlm@24
|
248 my %megahash =
|
rlm@24
|
249 (
|
rlm@24
|
250
|
rlm@24
|
251 'big' => $bold,
|
rlm@24
|
252
|
rlm@24
|
253 'basic' => $arrow,
|
rlm@24
|
254
|
rlm@24
|
255 'lines' => $direct,
|
rlm@24
|
256
|
rlm@24
|
257 'classic' => $classic,
|
rlm@24
|
258
|
rlm@24
|
259 'big_acrylic_clear' => $bold,
|
rlm@24
|
260
|
rlm@24
|
261 'classic_acrylic_clear' => $classic,
|
rlm@24
|
262
|
rlm@24
|
263 'basic_acrylic_clear' => $arrow,
|
rlm@24
|
264
|
rlm@24
|
265 'lines_acrylic_clear' => $direct
|
rlm@24
|
266 );
|
rlm@24
|
267
|
rlm@24
|
268
|
rlm@24
|
269
|
rlm@2
|
270 my $key = shift;
|
rlm@2
|
271
|
rlm@24
|
272
|
rlm@24
|
273 if (!$megahash{$key}){return $key;}
|
rlm@24
|
274
|
rlm@24
|
275 return $megahash{$key};
|
rlm@24
|
276
|
rlm@24
|
277
|
rlm@2
|
278
|
rlm@2
|
279
|
rlm@2
|
280 }
|
rlm@23
|
281
|
rlm@23
|
282
|
rlm@23
|
283
|
rlm@23
|
284
|
rlm@23
|
285
|
rlm@23
|
286
|
rlm@23
|
287
|
rlm@23
|
288
|
rlm@23
|
289 # this here function makes the paypal button go away so people know it's working!
|
rlm@23
|
290 sub vanish
|
rlm@23
|
291 {
|
rlm@24
|
292 return "";
|
rlm@23
|
293
|
rlm@23
|
294
|
rlm@23
|
295 }
|
rlm@23
|
296
|