Mercurial > laserkard

annotate buy.pl @ 40:1ac1409ea68c laserkard

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[svn r41] implemented dynamic text.
author rlm
date Mon, 25 Jan 2010 03:42:08 -0500
parents 021a9ab1ed5b
children ef8615de8a9c
rev   line source
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@40 87 $all =~ m/([^_]*)_(.*)/;
rlm@0 88
rlm@40 89 $materialcolor = $2;
rlm@40 90 $style = $1;
rlm@40 91 #here is where we handle important drawing commands relating to the cards.
rlm@40 92
rlm@0 93
rlm@0 94
rlm@37 95 $r = <<HERE;
rlm@37 96 <div id = "i_templates"><div class = 'ttyl'> <titletron>Select Style.</titletron></div>
rlm@32 97 <div id = 'stupid'>
rlm@40 98
rlm@40 99
rlm@40 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>
rlm@40 101
rlm@22 102
rlm@40 103
rlm@40 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>
rlm@40 105
rlm@22 106
rlm@40 107
rlm@40 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>
rlm@40 109
rlm@40 110
rlm@40 111
rlm@40 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" >
rlm@40 113
rlm@5 114 </div>
rlm@32 115 </div>
rlm@0 116
rlm@37 117 HERE
rlm@37 118
rlm@0 119
rlm@40 120 %shankHash =
rlm@40 121 (
rlm@40 122
rlm@40 123 big => template2,
rlm@40 124 basic => template3,
rlm@40 125 classic => template1,
rlm@40 126 lines => template4
rlm@40 127 );
rlm@40 128
rlm@40 129 $target = $shankHash{$style};
rlm@40 130
rlm@40 131
rlm@40 132
rlm@40 133
rlm@40 134 #$r =~ s/inputbox\(\['$target'\], \['inputbox'\]\)\;//;
rlm@40 135
rlm@40 136
rlm@40 137
rlm@40 138
rlm@40 139
rlm@0 140 return $r;
rlm@0 141 }
rlm@0 142
rlm@0 143
rlm@0 144
rlm@0 145
rlm@0 146 sub inputbox
rlm@0 147 {
rlm@0 148
rlm@0 149 #grab the type of template we'll be using <<<<
rlm@0 150 $type = shift;
rlm@0 151 # return $type;
rlm@0 152 # we have to care about both the type of template and the material and the color. these are stored in $type>>>>
rlm@0 153
rlm@0 154 #Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template.
rlm@0 155 #will probaly eventually create a script to automate the generation of these files.
rlm@0 156
rlm@0 157
rlm@0 158 #take care of everythign but acrylic clear type
rlm@2 159
rlm@2 160
rlm@2 161
rlm@2 162 {
rlm@2 163 local( $/, *FH ) ;
rlm@2 164 open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";
rlm@2 165 $z = <FH>;
rlm@2 166 }
rlm@0 167
rlm@0 168
rlm@0 169 #every type has it's own associated paylist file the contains the things we need
rlm@2 170
rlm@23 171 $z = '<div id = "whatever" onmouseover='."\"pokedex([\'args__$type\'],[\'pokedex\']);\">".$z.'</div>';
rlm@2 172 return $z;
rlm@2 173
rlm@2 174
rlm@0 175
rlm@0 176
rlm@0 177
rlm@0 178 }
rlm@0 179
rlm@0 180
rlm@0 181
rlm@0 182
rlm@0 183
rlm@0 184
rlm@0 185
rlm@0 186
rlm@0 187 sub display
rlm@0 188 {
rlm@0 189 $all = shift;
rlm@0 190
rlm@0 191
rlm@40 192 #~
rlm@40 193 #~ $t = <<HERE;
rlm@40 194 #~ <image src = "./images/display/PERL::PIC.jpg" onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">
rlm@40 195 #~
rlm@40 196 #~ <div id = overlay>
rlm@40 197 #~
rlm@40 198 #~
rlm@40 199 #~ </div>
rlm@40 200 #~
rlm@40 201 #~ HERE
rlm@40 202 #~
rlm@40 203 #~
rlm@40 204 #~
rlm@40 205 #~ $t =~ s/PERL::PIC/$all/g;
rlm@40 206
rlm@24 207 $t = <<HERE;
rlm@40 208 <image src = "./images/display/blank.jpg" onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">
rlm@29 209
rlm@29 210 <div id = overlay>
rlm@29 211
rlm@29 212
rlm@29 213 </div>
rlm@29 214
rlm@24 215 HERE
rlm@24 216
rlm@0 217 return $t;
rlm@0 218
rlm@0 219 }
rlm@0 220
rlm@0 221
rlm@0 222
rlm@0 223
rlm@0 224 sub gen
rlm@0 225 {
rlm@0 226 {
rlm@0 227 local( $/, *FH ) ;
rlm@0 228 open( FH, "<./buy.html" ) or die "sudden flaming death\n";
rlm@0 229 $a = <FH>;
rlm@0 230 }
rlm@0 231
rlm@0 232 {
rlm@0 233 local( $/, *FH ) ;
rlm@0 234 open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";
rlm@0 235 $b = <FH>;
rlm@0 236 }
rlm@0 237
rlm@2 238
rlm@2 239
rlm@40 240
rlm@40 241
rlm@2 242 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)
rlm@2 243 $b = &material("void_acrylic_clear",1);
rlm@2 244 $a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)
rlm@22 245 $b = &template("big_acrylic_clear");
rlm@2 246
rlm@40 247
rlm@40 248 $a =~ s/PERL-REPLACE::TEMPLATES/$b/;
rlm@2 249
rlm@22 250 $b = &display("big_acrylic_clear");
rlm@22 251 $a =~ s/PERL-REPLACE::DISPLAY/$b/;
rlm@22 252
rlm@22 253 $b = &inputbox("big_acrylic_clear");
rlm@22 254 $a =~ s/PERL-REPLACE::INPUTBOX/$b/;
rlm@2 255
rlm@24 256 $b = &pokedex('big');
rlm@24 257 $a =~ s/PERL-REPLACE::POKEDEX/$b/;
rlm@24 258
rlm@0 259
rlm@0 260 return $a
rlm@0 261
rlm@0 262
rlm@2 263 }
rlm@0 264
rlm@0 265
rlm@2 266
rlm@2 267 sub pokedex
rlm@2 268 {
rlm@2 269
rlm@24 270
rlm@24 271 $classic = <<HERE;
rlm@24 272 <h1>The Classic LaserKard.</h1>
rlm@24 273 Balanced and Complete. The original LaserKard. For those that wish to leave no stone unturned. It's all there.
rlm@24 274 HERE
rlm@24 275
rlm@24 276 $bold = <<HERE;
rlm@24 277 <h1>The Bold Kard.</h1>
rlm@24 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.
rlm@24 279 HERE
rlm@24 280
rlm@24 281 $arrow = <<HERE;
rlm@24 282 <h1>The Arrow Kard.</h1>
rlm@24 283 Precise and Straightforward. For those that seek to make a statement while being clear and concise. Straight as an arrow.
rlm@24 284 HERE
rlm@24 285
rlm@24 286 $direct = <<HERE;
rlm@24 287 <h1>The Direct Kard.</h1>
rlm@24 288 Thorough and Distinct. For those that aim to demonstrate their professionalism with style. Push the envelope. Be Direct.
rlm@24 289 HERE
rlm@24 290
rlm@24 291
rlm@24 292
rlm@24 293 my %megahash =
rlm@24 294 (
rlm@24 295
rlm@24 296 'big' => $bold,
rlm@24 297
rlm@24 298 'basic' => $arrow,
rlm@24 299
rlm@24 300 'lines' => $direct,
rlm@24 301
rlm@24 302 'classic' => $classic,
rlm@24 303
rlm@24 304 'big_acrylic_clear' => $bold,
rlm@24 305
rlm@24 306 'classic_acrylic_clear' => $classic,
rlm@24 307
rlm@24 308 'basic_acrylic_clear' => $arrow,
rlm@24 309
rlm@24 310 'lines_acrylic_clear' => $direct
rlm@24 311 );
rlm@24 312
rlm@24 313
rlm@24 314
rlm@2 315 my $key = shift;
rlm@2 316
rlm@24 317
rlm@24 318 if (!$megahash{$key}){return $key;}
rlm@24 319
rlm@24 320 return $megahash{$key};
rlm@24 321
rlm@24 322
rlm@2 323
rlm@2 324
rlm@2 325 }
rlm@23 326
rlm@23 327
rlm@23 328
rlm@23 329
rlm@23 330
rlm@23 331
rlm@23 332
rlm@23 333
rlm@23 334 # this here function makes the paypal button go away so people know it's working!
rlm@23 335 sub vanish
rlm@23 336 {
rlm@24 337 return "";
rlm@23 338
rlm@23 339
rlm@23 340 }
rlm@23 341