rlm@0: #!/usr/bin/perl rlm@0: rlm@0: rlm@0: use List::Util qw(first max maxstr min minstr reduce shuffle sum); rlm@0: use Storable; rlm@0: use CGI::Ajax; rlm@0: use CGI; rlm@42: use JSON; rlm@0: rlm@0: rlm@0: rlm@0: my $q = new CGI; rlm@0: rlm@0: rlm@0: rlm@0: my %hash = ( rlm@0: rlm@0: 'material' => \&material, rlm@2: 'pokedex' => \&pokedex, rlm@0: 'template' => \&template, rlm@0: 'inputbox' => \&inputbox, rlm@0: 'display' => \&display, rlm@23: 'change_rules' => \&change_rules, rlm@42: 'vanish' => \&vanish, rlm@42: 'updateForm' => \&updateForm rlm@23: ); rlm@0: rlm@0: rlm@0: rlm@0: my $pjx = CGI::Ajax->new(%hash); rlm@0: rlm@0: rlm@42: # this outputs the html for the page rlm@42: print $pjx->build_html($q,\&gen,{-Cache_Control => 'no-store, no-cache, must-revalidate', -Pragma => 'no-cache'}); rlm@42: rlm@42: rlm@42: rlm@42: sub updateForm rlm@42: rlm@42: { rlm@42: rlm@42: rlm@42: $key = shift; rlm@42: $value = shift; rlm@42: $hashString = shift; rlm@42: rlm@42: $perl_hash = decode_json $hashString; rlm@42: rlm@42: %fieldHash = %$perl_hash; rlm@42: rlm@42: rlm@42: $fieldHash{$key} = $value; rlm@42: $ref = \%fieldHash; rlm@42: rlm@42: $utf8_encoded_json_text = encode_json $ref ; rlm@42: return $utf8_encoded_json_text; rlm@42: rlm@42: } rlm@0: rlm@0: rlm@0: rlm@0: rlm@0: sub material{ rlm@0: rlm@0: $newvar = shift; rlm@0: rlm@0: my $t = $newvar; rlm@0: rlm@0: $newvar =~ m/([^_]*)_/; rlm@0: $newvar = $1; rlm@0: rlm@0: #return (($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked'); rlm@0: rlm@0: #$y = "$t
".(($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked')." rlm@2: rlm@2: { rlm@2: local( $/, *FH ) ; rlm@2: open( FH, "<./buy_pieces/materials2.html" ) or die "sudden flaming death\n"; rlm@2: $y = ; rlm@2: } rlm@2: rlm@2: @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: rlm@2: for (@symbols) rlm@2: { rlm@2: $c = $_; rlm@2: $c =~ s/PERL:://; rlm@2: $c =~ tr/[A-Z]/[a-z]/; rlm@2: $c =~ s/^/_/; rlm@2: rlm@2: $b = '"'.$newvar.$c.'"'.(($t =~ m/$c/) ? ' CHECKED ' : ''); rlm@2: $y =~ s/$_/$b/; rlm@2: } rlm@2: rlm@2: rlm@2: $first = shift; rlm@2: if ($first){ $y =~ s/display[^;]*;//g; } rlm@2: rlm@0: rlm@0: rlm@0: return $y; rlm@0: rlm@0: rlm@0: } rlm@0: rlm@0: rlm@0: rlm@0: sub template rlm@0: { rlm@0: rlm@0: $all = shift; rlm@40: $all =~ m/([^_]*)_(.*)/; rlm@0: rlm@40: $materialcolor = $2; rlm@40: $style = $1; rlm@40: #here is where we handle important drawing commands relating to the cards. rlm@40: rlm@0: rlm@0: rlm@37: $r = <
Select Style.
rlm@32:
rlm@40: rlm@40: rlm@42: rlm@42:
rlm@40: rlm@22: rlm@40: rlm@42:
rlm@40: rlm@22: rlm@40: rlm@42:
rlm@40: rlm@40: rlm@40: rlm@42: rlm@40: rlm@5:
rlm@32: rlm@0: rlm@37: HERE rlm@37: rlm@0: rlm@40: %shankHash = rlm@40: ( rlm@40: rlm@40: big => template2, rlm@40: basic => template3, rlm@40: classic => template1, rlm@40: lines => template4 rlm@40: ); rlm@40: rlm@40: $target = $shankHash{$style}; rlm@40: rlm@40: rlm@40: rlm@40: rlm@40: #$r =~ s/inputbox\(\['$target'\], \['inputbox'\]\)\;//; rlm@40: rlm@40: rlm@40: rlm@40: rlm@40: rlm@0: return $r; rlm@0: } rlm@0: rlm@0: rlm@0: rlm@0: rlm@0: sub inputbox rlm@0: { rlm@0: rlm@0: #grab the type of template we'll be using <<<< rlm@0: $type = shift; rlm@42: rlm@42: $hashString = shift; rlm@42: #return $hashString; rlm@42: rlm@42: $perl_hash = decode_json $hashString; rlm@42: rlm@42: %fieldHash = %$perl_hash; rlm@42: rlm@42: rlm@0: # we have to care about both the type of template and the material and the color. these are stored in $type>>>> rlm@0: rlm@0: #Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template. rlm@0: #will probaly eventually create a script to automate the generation of these files. rlm@0: rlm@0: rlm@0: #take care of everythign but acrylic clear type rlm@2: rlm@2: { rlm@2: local( $/, *FH ) ; rlm@2: open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n"; rlm@2: $z = ; rlm@2: } rlm@0: rlm@0: rlm@0: #every type has it's own associated paylist file the contains the things we need rlm@2: rlm@23: $z = '
".$z.'
'; rlm@2: rlm@2: rlm@42: foreach my $key ( keys %fieldHash ) rlm@42: { rlm@0: rlm@42: my $replace = $fieldHash{$key}; rlm@42: rlm@42: #id="Name" value = "PERL::NAME" rlm@42: rlm@42: rlm@42: $z =~ s/id="$key"/id="$key" value = "$replace"/g; rlm@0: rlm@0: rlm@0: } rlm@0: rlm@0: rlm@42: return $z; rlm@0: rlm@0: rlm@0: rlm@0: rlm@0: rlm@42: } rlm@42: rlm@42: rlm@42: rlm@0: rlm@0: sub display rlm@0: { rlm@0: $all = shift; rlm@0: rlm@0: rlm@40: #~ rlm@40: #~ $t = < rlm@40: #~ rlm@40: #~
rlm@40: #~ rlm@40: #~ rlm@40: #~
rlm@40: #~ rlm@40: #~ HERE rlm@40: #~ rlm@40: #~ rlm@40: #~ rlm@40: #~ $t =~ s/PERL::PIC/$all/g; rlm@40: rlm@24: $t = < rlm@29: rlm@29:
rlm@29: rlm@29: rlm@29:
rlm@29: rlm@24: HERE rlm@24: rlm@0: return $t; rlm@0: rlm@0: } rlm@0: rlm@0: rlm@0: rlm@0: rlm@0: sub gen rlm@0: { rlm@0: { rlm@0: local( $/, *FH ) ; rlm@0: open( FH, "<./buy.html" ) or die "sudden flaming death\n"; rlm@0: $a = ; rlm@0: } rlm@0: rlm@0: { rlm@0: local( $/, *FH ) ; rlm@0: open( FH, "<./top_menu.include" ) or die "sudden flaming death\n"; rlm@0: $b = ; rlm@0: } rlm@0: rlm@44: { rlm@44: local( $/, *FH ) ; rlm@44: open( FH, "<./cardDefinitions.JSON" ) or die "sudden flaming death\n"; rlm@44: $c = ; rlm@44: } rlm@2: rlm@44: $a =~s/PERL::DEFS/$c/; rlm@2: rlm@40: rlm@40: rlm@2: $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to , but in perl and with more memory problems :) rlm@2: $b = &material("void_acrylic_clear",1); rlm@2: $a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :) rlm@22: $b = &template("big_acrylic_clear"); rlm@2: rlm@40: rlm@44: rlm@44: rlm@44: rlm@40: $a =~ s/PERL-REPLACE::TEMPLATES/$b/; rlm@2: rlm@22: $b = &display("big_acrylic_clear"); rlm@22: $a =~ s/PERL-REPLACE::DISPLAY/$b/; rlm@22: rlm@44: $initials = <The Classic LaserKard. rlm@24: Balanced and Complete. The original LaserKard. For those that wish to leave no stone unturned. It's all there. rlm@24: HERE rlm@24: rlm@24: $bold = <The Bold Kard. rlm@24: 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: HERE rlm@24: rlm@24: $arrow = <The Arrow Kard. rlm@24: Precise and Straightforward. For those that seek to make a statement while being clear and concise. Straight as an arrow. rlm@24: HERE rlm@24: rlm@24: $direct = <The Direct Kard. rlm@24: Thorough and Distinct. For those that aim to demonstrate their professionalism with style. Push the envelope. Be Direct. rlm@24: HERE rlm@24: rlm@24: rlm@24: rlm@24: my %megahash = rlm@24: ( rlm@24: rlm@24: 'big' => $bold, rlm@24: rlm@24: 'basic' => $arrow, rlm@24: rlm@24: 'lines' => $direct, rlm@24: rlm@24: 'classic' => $classic, rlm@24: rlm@24: 'big_acrylic_clear' => $bold, rlm@24: rlm@24: 'classic_acrylic_clear' => $classic, rlm@24: rlm@24: 'basic_acrylic_clear' => $arrow, rlm@24: rlm@24: 'lines_acrylic_clear' => $direct rlm@24: ); rlm@24: rlm@24: rlm@24: rlm@2: my $key = shift; rlm@2: rlm@24: rlm@24: if (!$megahash{$key}){return $key;} rlm@24: rlm@24: return $megahash{$key}; rlm@24: rlm@24: rlm@2: rlm@2: rlm@2: } rlm@23: rlm@23: rlm@23: rlm@23: rlm@23: rlm@23: rlm@23: rlm@23: rlm@23: # this here function makes the paypal button go away so people know it's working! rlm@23: sub vanish rlm@23: { rlm@24: return ""; rlm@23: rlm@23: rlm@23: } rlm@23: