Mercurial > laserkard

annotate buy.pl @ 50:1b5417799713 laserkard

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