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@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@23: 'vanish' => \&vanish rlm@23: ); rlm@0: rlm@0: rlm@0: rlm@0: my $pjx = CGI::Ajax->new(%hash); rlm@0: #$pjx->JSDEBUG(1); rlm@0: #$pjx->DEBUG(1); rlm@0: rlm@28: 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: 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@0: $all =~ m/_(.*)/; rlm@0: rlm@0: $materialcolor = $1; rlm@0: rlm@0: rlm@37: $r = <
Select Style.
rlm@32:
rlm@37:
rlm@22: rlm@37:
rlm@22: rlm@37:
rlm@22: rlm@37: rlm@5:
rlm@32: rlm@0: rlm@37: HERE rlm@37: rlm@0: 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@0: # return $type; 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: 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: return $z; rlm@2: rlm@2: rlm@0: rlm@0: rlm@0: rlm@0: } rlm@0: rlm@0: rlm@0: rlm@0: rlm@0: rlm@0: rlm@0: rlm@0: rlm@0: sub display rlm@0: { rlm@0: $all = shift; rlm@0: rlm@0: rlm@0: rlm@24: $t = < rlm@29: rlm@29:
rlm@29: rlm@29: rlm@29:
rlm@29: rlm@24: HERE rlm@24: rlm@24: rlm@29: rlm@24: $t =~ s/PERL::PIC/$all/g; rlm@24: rlm@29: 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@2: rlm@2: 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@16: #$a =~ s/PERL-REPLACE::TEMPLATES//; rlm@16: $a =~ s/PERL-REPLACE::TEMPLATES/$b/; #comment out one or the other! rlm@2: rlm@22: $b = &display("big_acrylic_clear"); rlm@22: $a =~ s/PERL-REPLACE::DISPLAY/$b/; rlm@22: rlm@22: $b = &inputbox("big_acrylic_clear"); rlm@22: $a =~ s/PERL-REPLACE::INPUTBOX/$b/; rlm@2: rlm@24: $b = &pokedex('big'); rlm@24: $a =~ s/PERL-REPLACE::POKEDEX/$b/; rlm@24: rlm@0: rlm@0: return $a rlm@0: rlm@0: rlm@2: } rlm@0: rlm@0: rlm@2: rlm@2: sub pokedex rlm@2: { rlm@2: rlm@24: rlm@24: $classic = <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: