Mercurial > laserkard

annotate buy.pl @ 44:1045db9799e3 laserkard

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[svn r45] Greatly Enhanced Responsiveness of the website.
author rlm
date Thu, 28 Jan 2010 04:10:44 -0500
parents ef8615de8a9c
children 4431dc7d4bb5
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@42 8 use JSON;
rlm@0 9
rlm@0 10
rlm@0 11
rlm@0 12 my $q = new CGI;
rlm@0 13
rlm@0 14
rlm@0 15
rlm@0 16 my %hash = (
rlm@0 17
rlm@0 18 'material' => \&material,
rlm@2 19 'pokedex' => \&pokedex,
rlm@0 20 'template' => \&template,
rlm@0 21 'inputbox' => \&inputbox,
rlm@0 22 'display' => \&display,
rlm@23 23 'change_rules' => \&change_rules,
rlm@42 24 'vanish' => \&vanish,
rlm@42 25 'updateForm' => \&updateForm
rlm@23 26 );
rlm@0 27
rlm@0 28
rlm@0 29
rlm@0 30 my $pjx = CGI::Ajax->new(%hash);
rlm@0 31
rlm@0 32
rlm@42 33 # this outputs the html for the page
rlm@42 34 print $pjx->build_html($q,\&gen,{-Cache_Control => 'no-store, no-cache, must-revalidate', -Pragma => 'no-cache'});
rlm@42 35
rlm@42 36
rlm@42 37
rlm@42 38 sub updateForm
rlm@42 39
rlm@42 40 {
rlm@42 41
rlm@42 42
rlm@42 43 $key = shift;
rlm@42 44 $value = shift;
rlm@42 45 $hashString = shift;
rlm@42 46
rlm@42 47 $perl_hash = decode_json $hashString;
rlm@42 48
rlm@42 49 %fieldHash = %$perl_hash;
rlm@42 50
rlm@42 51
rlm@42 52 $fieldHash{$key} = $value;
rlm@42 53 $ref = \%fieldHash;
rlm@42 54
rlm@42 55 $utf8_encoded_json_text = encode_json $ref ;
rlm@42 56 return $utf8_encoded_json_text;
rlm@42 57
rlm@42 58 }
rlm@0 59
rlm@0 60
rlm@0 61
rlm@0 62
rlm@0 63 sub material{
rlm@0 64
rlm@0 65 $newvar = shift;
rlm@0 66
rlm@0 67 my $t = $newvar;
rlm@0 68
rlm@0 69 $newvar =~ m/([^_]*)_/;
rlm@0 70 $newvar = $1;
rlm@0 71
rlm@0 72 #return (($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked');
rlm@0 73
rlm@0 74 #$y = "$t<br>".(($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked')."
rlm@2 75
rlm@2 76 {
rlm@2 77 local( $/, *FH ) ;
rlm@2 78 open( FH, "<./buy_pieces/materials2.html" ) or die "sudden flaming death\n";
rlm@2 79 $y = <FH>;
rlm@2 80 }
rlm@2 81
rlm@2 82 @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 83
rlm@2 84 for (@symbols)
rlm@2 85 {
rlm@2 86 $c = $_;
rlm@2 87 $c =~ s/PERL:://;
rlm@2 88 $c =~ tr/[A-Z]/[a-z]/;
rlm@2 89 $c =~ s/^/_/;
rlm@2 90
rlm@2 91 $b = '"'.$newvar.$c.'"'.(($t =~ m/$c/) ? ' CHECKED ' : '');
rlm@2 92 $y =~ s/$_/$b/;
rlm@2 93 }
rlm@2 94
rlm@2 95
rlm@2 96 $first = shift;
rlm@2 97 if ($first){ $y =~ s/display[^;]*;//g; }
rlm@2 98
rlm@0 99
rlm@0 100
rlm@0 101 return $y;
rlm@0 102
rlm@0 103
rlm@0 104 }
rlm@0 105
rlm@0 106
rlm@0 107
rlm@0 108 sub template
rlm@0 109 {
rlm@0 110
rlm@0 111 $all = shift;
rlm@40 112 $all =~ m/([^_]*)_(.*)/;
rlm@0 113
rlm@40 114 $materialcolor = $2;
rlm@40 115 $style = $1;
rlm@40 116 #here is where we handle important drawing commands relating to the cards.
rlm@40 117
rlm@0 118
rlm@0 119
rlm@37 120 $r = <<HERE;
rlm@37 121 <div id = "i_templates"><div class = 'ttyl'> <titletron>Select Style.</titletron></div>
rlm@32 122 <div id = 'stupid'>
rlm@40 123
rlm@40 124
rlm@42 125 <input TYPE="image" src = "./images/templates/big_$materialcolor.jpg"
rlm@42 126 onmouseover="pokedex(['args__big'],['pokedex']);"
rlm@42 127 onclick=
rlm@42 128 "display(['template2'], ['display']);
rlm@42 129 inputbox(['template2', 'formValues'], ['inputbox']);
rlm@42 130 material(['template2'], ['materials']);
rlm@42 131 redraw('bold');" ID="template2" NAME="template2" VALUE="big_$materialcolor">
rlm@42 132 <br>
rlm@40 133
rlm@22 134
rlm@40 135
rlm@42 136 <input TYPE="image" src = "./images/templates/basic_$materialcolor.jpg"
rlm@42 137 onmouseover="pokedex(['args__basic'],['pokedex']);"
rlm@42 138 onclick=
rlm@42 139 "display(['template3'], ['display']);
rlm@42 140 inputbox(['template3', 'formValues'], ['inputbox']);
rlm@42 141 material(['template3'], ['materials']);
rlm@42 142 redraw('arrow');" ID="template3" NAME="template3" VALUE="basic_$materialcolor" ><br>
rlm@40 143
rlm@22 144
rlm@40 145
rlm@42 146 <input TYPE="image" src = "./images/templates/classic_$materialcolor.jpg"
rlm@42 147 onmouseover="pokedex(['args__classic'],['pokedex']);"
rlm@42 148 onclick=
rlm@42 149 "display(['template1'], ['display']);
rlm@42 150 inputbox(['template1', 'formValues'], ['inputbox']);
rlm@42 151 material(['template1'], ['materials']);
rlm@42 152 redraw('classic');" ID="template1" NAME="template1" VALUE="classic_$materialcolor" ><br>
rlm@40 153
rlm@40 154
rlm@40 155
rlm@42 156 <input TYPE="image" src = "./images/templates/lines_$materialcolor.jpg"
rlm@42 157 onmouseover="pokedex(['args__lines'],['pokedex']);"
rlm@42 158 onclick=
rlm@42 159 "display(['template4'], ['display']);
rlm@42 160 inputbox(['template4', 'formValues'], ['inputbox']);
rlm@42 161 material(['template4'], ['materials']);
rlm@42 162 redraw('direct');" ID="template4" NAME="template4" VALUE="lines_$materialcolor" >
rlm@40 163
rlm@5 164 </div>
rlm@32 165 </div>
rlm@0 166
rlm@37 167 HERE
rlm@37 168
rlm@0 169
rlm@40 170 %shankHash =
rlm@40 171 (
rlm@40 172
rlm@40 173 big => template2,
rlm@40 174 basic => template3,
rlm@40 175 classic => template1,
rlm@40 176 lines => template4
rlm@40 177 );
rlm@40 178
rlm@40 179 $target = $shankHash{$style};
rlm@40 180
rlm@40 181
rlm@40 182
rlm@40 183
rlm@40 184 #$r =~ s/inputbox\(\['$target'\], \['inputbox'\]\)\;//;
rlm@40 185
rlm@40 186
rlm@40 187
rlm@40 188
rlm@40 189
rlm@0 190 return $r;
rlm@0 191 }
rlm@0 192
rlm@0 193
rlm@0 194
rlm@0 195
rlm@0 196 sub inputbox
rlm@0 197 {
rlm@0 198
rlm@0 199 #grab the type of template we'll be using <<<<
rlm@0 200 $type = shift;
rlm@42 201
rlm@42 202 $hashString = shift;
rlm@42 203 #return $hashString;
rlm@42 204
rlm@42 205 $perl_hash = decode_json $hashString;
rlm@42 206
rlm@42 207 %fieldHash = %$perl_hash;
rlm@42 208
rlm@42 209
rlm@0 210 # we have to care about both the type of template and the material and the color. these are stored in $type>>>>
rlm@0 211
rlm@0 212 #Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template.
rlm@0 213 #will probaly eventually create a script to automate the generation of these files.
rlm@0 214
rlm@0 215
rlm@0 216 #take care of everythign but acrylic clear type
rlm@2 217
rlm@2 218 {
rlm@2 219 local( $/, *FH ) ;
rlm@2 220 open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";
rlm@2 221 $z = <FH>;
rlm@2 222 }
rlm@0 223
rlm@0 224
rlm@0 225 #every type has it's own associated paylist file the contains the things we need
rlm@2 226
rlm@23 227 $z = '<div id = "whatever" onmouseover='."\"pokedex([\'args__$type\'],[\'pokedex\']);\">".$z.'</div>';
rlm@2 228
rlm@2 229
rlm@42 230 foreach my $key ( keys %fieldHash )
rlm@42 231 {
rlm@0 232
rlm@42 233 my $replace = $fieldHash{$key};
rlm@42 234
rlm@42 235 #id="Name" value = "PERL::NAME"
rlm@42 236
rlm@42 237
rlm@42 238 $z =~ s/id="$key"/id="$key" value = "$replace"/g;
rlm@0 239
rlm@0 240
rlm@0 241 }
rlm@0 242
rlm@0 243
rlm@42 244 return $z;
rlm@0 245
rlm@0 246
rlm@0 247
rlm@0 248
rlm@0 249
rlm@42 250 }
rlm@42 251
rlm@42 252
rlm@42 253
rlm@0 254
rlm@0 255 sub display
rlm@0 256 {
rlm@0 257 $all = shift;
rlm@0 258
rlm@0 259
rlm@40 260 #~
rlm@40 261 #~ $t = <<HERE;
rlm@40 262 #~ <image src = "./images/display/PERL::PIC.jpg" onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">
rlm@40 263 #~
rlm@40 264 #~ <div id = overlay>
rlm@40 265 #~
rlm@40 266 #~
rlm@40 267 #~ </div>
rlm@40 268 #~
rlm@40 269 #~ HERE
rlm@40 270 #~
rlm@40 271 #~
rlm@40 272 #~
rlm@40 273 #~ $t =~ s/PERL::PIC/$all/g;
rlm@40 274
rlm@24 275 $t = <<HERE;
rlm@40 276 <image src = "./images/display/blank.jpg" onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">
rlm@29 277
rlm@29 278 <div id = overlay>
rlm@29 279
rlm@29 280
rlm@29 281 </div>
rlm@29 282
rlm@24 283 HERE
rlm@24 284
rlm@0 285 return $t;
rlm@0 286
rlm@0 287 }
rlm@0 288
rlm@0 289
rlm@0 290
rlm@0 291
rlm@0 292 sub gen
rlm@0 293 {
rlm@0 294 {
rlm@0 295 local( $/, *FH ) ;
rlm@0 296 open( FH, "<./buy.html" ) or die "sudden flaming death\n";
rlm@0 297 $a = <FH>;
rlm@0 298 }
rlm@0 299
rlm@0 300 {
rlm@0 301 local( $/, *FH ) ;
rlm@0 302 open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";
rlm@0 303 $b = <FH>;
rlm@0 304 }
rlm@0 305
rlm@44 306 {
rlm@44 307 local( $/, *FH ) ;
rlm@44 308 open( FH, "<./cardDefinitions.JSON" ) or die "sudden flaming death\n";
rlm@44 309 $c = <FH>;
rlm@44 310 }
rlm@2 311
rlm@44 312 $a =~s/PERL::DEFS/$c/;
rlm@2 313
rlm@40 314
rlm@40 315
rlm@2 316 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)
rlm@2 317 $b = &material("void_acrylic_clear",1);
rlm@2 318 $a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)
rlm@22 319 $b = &template("big_acrylic_clear");
rlm@2 320
rlm@40 321
rlm@44 322
rlm@44 323
rlm@44 324
rlm@40 325 $a =~ s/PERL-REPLACE::TEMPLATES/$b/;
rlm@2 326
rlm@22 327 $b = &display("big_acrylic_clear");
rlm@22 328 $a =~ s/PERL-REPLACE::DISPLAY/$b/;
rlm@22 329
rlm@44 330 $initials = <<HERE ;
rlm@44 331 {
rlm@44 332 "Name":"James Bond",
rlm@44 333 "Email":"jbond\@mi6.co.uk",
rlm@44 334 "Phone": "123.456.7890",
rlm@44 335 "Company": "MI6",
rlm@44 336 "Website" : "http://jamesbond.com",
rlm@44 337 "Occupation" : "Secret Agent"
rlm@44 338 }
rlm@44 339
rlm@42 340 HERE
rlm@42 341
rlm@42 342
rlm@44 343
rlm@42 344 $b = &inputbox("big_acrylic_clear", $initials);
rlm@22 345 $a =~ s/PERL-REPLACE::INPUTBOX/$b/;
rlm@2 346
rlm@24 347 $b = &pokedex('big');
rlm@24 348 $a =~ s/PERL-REPLACE::POKEDEX/$b/;
rlm@24 349
rlm@0 350
rlm@42 351
rlm@42 352 #$b = &updateForm('fuck','12', '{}');
rlm@42 353 $a =~ s/PERL::INITIALVALUES/$initials/;
rlm@42 354
rlm@42 355
rlm@42 356
rlm@0 357 return $a
rlm@0 358
rlm@0 359
rlm@2 360 }
rlm@0 361
rlm@0 362
rlm@2 363
rlm@2 364 sub pokedex
rlm@2 365 {
rlm@2 366
rlm@24 367
rlm@24 368 $classic = <<HERE;
rlm@24 369 <h1>The Classic LaserKard.</h1>
rlm@24 370 Balanced and Complete. The original LaserKard. For those that wish to leave no stone unturned. It's all there.
rlm@24 371 HERE
rlm@24 372
rlm@24 373 $bold = <<HERE;
rlm@24 374 <h1>The Bold Kard.</h1>
rlm@24 375 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 376 HERE
rlm@24 377
rlm@24 378 $arrow = <<HERE;
rlm@24 379 <h1>The Arrow Kard.</h1>
rlm@24 380 Precise and Straightforward. For those that seek to make a statement while being clear and concise. Straight as an arrow.
rlm@24 381 HERE
rlm@24 382
rlm@24 383 $direct = <<HERE;
rlm@24 384 <h1>The Direct Kard.</h1>
rlm@24 385 Thorough and Distinct. For those that aim to demonstrate their professionalism with style. Push the envelope. Be Direct.
rlm@24 386 HERE
rlm@24 387
rlm@24 388
rlm@24 389
rlm@24 390 my %megahash =
rlm@24 391 (
rlm@24 392
rlm@24 393 'big' => $bold,
rlm@24 394
rlm@24 395 'basic' => $arrow,
rlm@24 396
rlm@24 397 'lines' => $direct,
rlm@24 398
rlm@24 399 'classic' => $classic,
rlm@24 400
rlm@24 401 'big_acrylic_clear' => $bold,
rlm@24 402
rlm@24 403 'classic_acrylic_clear' => $classic,
rlm@24 404
rlm@24 405 'basic_acrylic_clear' => $arrow,
rlm@24 406
rlm@24 407 'lines_acrylic_clear' => $direct
rlm@24 408 );
rlm@24 409
rlm@24 410
rlm@24 411
rlm@2 412 my $key = shift;
rlm@2 413
rlm@24 414
rlm@24 415 if (!$megahash{$key}){return $key;}
rlm@24 416
rlm@24 417 return $megahash{$key};
rlm@24 418
rlm@24 419
rlm@2 420
rlm@2 421
rlm@2 422 }
rlm@23 423
rlm@23 424
rlm@23 425
rlm@23 426
rlm@23 427
rlm@23 428
rlm@23 429
rlm@23 430
rlm@23 431 # this here function makes the paypal button go away so people know it's working!
rlm@23 432 sub vanish
rlm@23 433 {
rlm@24 434 return "";
rlm@23 435
rlm@23 436
rlm@23 437 }
rlm@23 438