rlm@51: package Laserkard;
rlm@51: 
rlm@51: use List::Util qw(first max maxstr min minstr reduce shuffle sum);
rlm@51: use Storable;
rlm@51: use CGI::Ajax;
rlm@51: use CGI;
rlm@51: use JSON;
rlm@51: use Laserkard;
rlm@51: use base 'Exporter';
rlm@51: 
rlm@51: our @EXPORT = 
rlm@51: qw(
rlm@51: material
rlm@51: template 
rlm@51: inputbox
rlm@51: display
rlm@51: change_rules
rlm@51: vanish
rlm@51: updateForm
rlm@51: cardType
rlm@51: );
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: 
rlm@79: sub cardType { return $_[0];}
rlm@79: 
rlm@79: sub updateForm
rlm@51: {
rlm@79:     ###################
rlm@79:     $key = shift;
rlm@79:     $value = shift;
rlm@79:     $hashString = shift;
rlm@79:     ###################
rlm@51: 
rlm@79:     $perl_hash  = decode_json($hashString);
rlm@79:     
rlm@79:     %fieldHash = %$perl_hash;
rlm@79:     
rlm@79:     $fieldHash{$key} = $value;
rlm@79:     $ref = \%fieldHash;
rlm@79:     
rlm@79:     $utf8_encoded_json_text = encode_json($ref);
rlm@79:     return $utf8_encoded_json_text;
rlm@51: }
rlm@51: 
rlm@51: 
rlm@51: 
rlm@79: 
rlm@79: sub material
rlm@51: {
rlm@79:     ##################
rlm@79:     $newvar = shift;
rlm@79:     ##################
rlm@79:     my $t = $newvar;
rlm@79:     
rlm@79:     $newvar =~ m/([^_]*)_/;
rlm@79:     $newvar = $1;
rlm@79:     
rlm@79:     #return (($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked');
rlm@79:     
rlm@79:     #$y = "$t<br>".(($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked')."
rlm@79:     
rlm@79:     {
rlm@79: 	local( $/, *FH ) ;
rlm@79: 	open( FH, "<./buy_pieces/materials2.html" ) 
rlm@79: 	    or die "sudden flaming death\n";
rlm@79: 	$y = <FH>;
rlm@79:     }
rlm@79:     
rlm@79:     @symbols = qw (PERL::ACRYLIC_CLEAR PERL::ACRYLIC_BLUE PERL::ACRYLIC_GREEN 
rlm@79:                    PERL::ALUMINUM_RED PERL::ALUMINUM_BLUE 
rlm@79:                    PERL::ALUMINUM_GREEN PERL::ALUMINUM_BLACK);
rlm@79:     
rlm@79:     for (@symbols)
rlm@79:     {
rlm@51: 	$c = $_;
rlm@51: 	$c =~ s/PERL:://;
rlm@51: 	$c =~ tr/[A-Z]/[a-z]/;
rlm@51: 	$c =~ s/^/_/;
rlm@51: 	
rlm@51: 	$b = '"'.$newvar.$c.'"'.(($t =~ m/$c/) ? '  CHECKED ' : '');
rlm@51: 	$y =~ s/$_/$b/; 
rlm@79:     }
rlm@51: 	
rlm@51: 	$first = shift;
rlm@51: 	if ($first){  $y =~ s/display[^;]*;//g; }
rlm@51: 	return $y;
rlm@51: }
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: sub template
rlm@51: {
rlm@79:     
rlm@79:     $all = shift;
rlm@79:     $all =~ m/([^_]*)_(.*)/;
rlm@79:     
rlm@79:     $materialcolor = $2;
rlm@79:     $style = $1;
rlm@51: #here is where we handle important drawing commands relating to the cards.
rlm@79:     
rlm@79:     
rlm@79:     
rlm@79:     $r =  <<HERE;
rlm@79:     <div id = "i_templates">
rlm@79: 	<div class = 'ttyl'> <titletron>Select Style.</titletron></div>
rlm@79: 	<div id = 'stupid'>
rlm@79: 	    <input 
rlm@79: 	        TYPE="image" 
rlm@79: 	        src = "./images/templates/big_$materialcolor.jpg" 	
rlm@79: 	        onmouseover="pokedex('big_$materialcolor');"
rlm@79: 	        onmouseout = 
rlm@79: 		"pokedex(document.getElementById('currentSpec').innerHTML);"
rlm@79: 		 	
rlm@79: 		onclick=
rlm@79: 		"display(['template2'], ['display']); 
rlm@79:                  inputbox(['template2', 'formValues'], ['inputbox']);
rlm@79:                  material(['template2'], ['materials']);
rlm@79:                  cardType(['template2'], ['currentSpec']);
rlm@79:                  redraw('bold');" 
rlm@79: 		ID="template2" 
rlm@79:                 NAME="template2" 
rlm@79:                 VALUE="big_$materialcolor">
rlm@79: 		<br>
rlm@51: 
rlm@51:   
rlm@51: 
rlm@51: <input TYPE="image" src = "./images/templates/basic_$materialcolor.jpg"
rlm@51: onmouseover="pokedex('basic_$materialcolor');" 
rlm@51: onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
rlm@51: onclick=
rlm@51: "display(['template3'], ['display']); 
rlm@51: inputbox(['template3', 'formValues'], ['inputbox']);
rlm@51: material(['template3'], ['materials']);
rlm@51: cardType(['template3'], ['currentSpec']);
rlm@51: redraw('arrow');" 
rlm@51: ID="template3" NAME="template3" VALUE="basic_$materialcolor"          ><br>
rlm@51: 
rlm@51:  
rlm@51: 
rlm@51: <input TYPE="image" src = "./images/templates/classic_$materialcolor.jpg"  
rlm@51: onmouseover="pokedex('classic_$materialcolor');" 
rlm@51: onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
rlm@51: onclick=
rlm@51: "display(['template1'], ['display']); 
rlm@51: inputbox(['template1', 'formValues'], ['inputbox']);
rlm@51: material(['template1'], ['materials']);
rlm@51: cardType(['template1'], ['currentSpec']);
rlm@51: redraw('classic');" 
rlm@51: ID="template1" NAME="template1" VALUE="classic_$materialcolor"    ><br>
rlm@51: 
rlm@51:  
rlm@51: 
rlm@51: <input TYPE="image" src = "./images/templates/lines_$materialcolor.jpg" 
rlm@51: onmouseover="pokedex('lines_$materialcolor');" 	
rlm@51: onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
rlm@51: onclick=
rlm@51: "display(['template4'], ['display']); 
rlm@51: inputbox(['template4', 'formValues'], ['inputbox']);
rlm@51: material(['template4'], ['materials']);
rlm@51: cardType(['template4'], ['currentSpec']);
rlm@51: redraw('direct');" 
rlm@51: ID="template4" NAME="template4" VALUE="lines_$materialcolor"           > 
rlm@51: 
rlm@51: 	</div>
rlm@51: 	</div>
rlm@51: 
rlm@51: HERE
rlm@51: 
rlm@51: 
rlm@51: %shankHash = 
rlm@51: (
rlm@51: 
rlm@51: big => template2,  
rlm@51: basic => template3,
rlm@51: classic => template1,
rlm@51: lines  => template4
rlm@51: );
rlm@51: 
rlm@51: $target = $shankHash{$style};
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: return $r;
rlm@51: }
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: sub inputbox
rlm@51: {
rlm@51: 
rlm@51: #grab the type of template we'll be using <<<<
rlm@51: 	$type = shift;
rlm@51: 	
rlm@51: 	$hashString = shift;
rlm@51: 	#return $hashString;
rlm@51: 	
rlm@51: 	$perl_hash  = decode_json $hashString;
rlm@51: 
rlm@51: 	%fieldHash = %$perl_hash;
rlm@51:  
rlm@51: 
rlm@51: # we have to care about both the type of template and the material and the color. these are stored in $type>>>>
rlm@51: 
rlm@51: #Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template.
rlm@51: #will probaly eventually create a script to automate the generation of these files.
rlm@51: 
rlm@51: 
rlm@51: #take care of everythign but acrylic clear type
rlm@51: 
rlm@51:   {
rlm@51:     local( $/, *FH ) ;
rlm@51:     open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";
rlm@51:     $z = <FH>;
rlm@51:   }
rlm@51: 
rlm@51: 
rlm@51: #every type has it's own associated paylist file the contains the things we need
rlm@51: 
rlm@51: $z = <<HERE . $z;
rlm@51: <div id = "whatever" onmouseover = "pokedex(document.getElementById('currentSpec').innerHTML);">
rlm@51: HERE
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: $z = $z.'</div>';
rlm@51: 
rlm@51: 
rlm@51: foreach my $key ( keys %fieldHash )
rlm@51: {
rlm@51: 
rlm@51: my $replace  = $fieldHash{$key};
rlm@51: 
rlm@51: #id="Name" value = "PERL::NAME" 
rlm@51: 
rlm@51: 
rlm@51: $z =~ s/id="$key"/id="$key" value = "$replace"/g;
rlm@51: 
rlm@51: 
rlm@51: }
rlm@51: 
rlm@51: 
rlm@51: return $z;
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: }
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: sub display
rlm@51: {
rlm@51: 	$all = shift;
rlm@51: 	
rlm@51: 	
rlm@51: 	#~ 
rlm@51: 	#~ $t = <<HERE;
rlm@51: 	#~ <image src = "./images/display/PERL::PIC.jpg" 	onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">
rlm@51: 	#~ 
rlm@51: 	#~ <div id = overlay>
rlm@51: #~ 
rlm@51: #~ 
rlm@51: 	#~ </div>
rlm@51: 	#~ 
rlm@51: #~ HERE
rlm@51: #~ 
rlm@51: #~ 
rlm@51: #~ 
rlm@51: #~ $t =~ s/PERL::PIC/$all/g;
rlm@51: 
rlm@51: 	$t = <<HERE;
rlm@57: 	<image src = "./images/blank.jpg" 	
rlm@51: 	onmouseover = "pokedex(document.getElementById('currentSpec').innerHTML);"
rlm@51: 	>
rlm@51: 	
rlm@51: 	<div id = overlay>
rlm@51: 
rlm@51: 
rlm@51: 	</div>
rlm@51: 	
rlm@51: HERE
rlm@51: 	
rlm@51: 	return $t;
rlm@51: 	
rlm@51: }
rlm@51: 
rlm@51: 
rlm@51: sub genBuy
rlm@51: 
rlm@51: {
rlm@51: return gen("buy.html");	
rlm@51: 	
rlm@51: }
rlm@51: 
rlm@51: 
rlm@51: sub genEcho
rlm@51: {
rlm@51: 	
rlm@51: return gen("echo.html");
rlm@51: 	
rlm@51: }
rlm@51: 
rlm@51: 
rlm@51: sub gen
rlm@51: {
rlm@51: 	
rlm@51: 	my $target = shift;
rlm@51: 	
rlm@51:   {
rlm@51:     local( $/, *FH ) ;
rlm@51:     open( FH, "<./$target" ) or die "sudden flaming death\n";
rlm@51:     $a = <FH>;
rlm@51:    }
rlm@51: 
rlm@51:   {
rlm@51:     local( $/, *FH ) ;
rlm@51:     open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";
rlm@51:     $b = <FH>;
rlm@51:    }
rlm@51: 
rlm@51:   {
rlm@51:     local( $/, *FH ) ;
rlm@51:     open( FH, "<./cardDefinitions.JSON" ) or die "sudden flaming death\n";
rlm@51:     $c = <FH>;
rlm@51:    }
rlm@51: 
rlm@51: $a =~s/PERL::DEFS/$c/;
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)
rlm@51: $b = &material("void_acrylic_clear",1);
rlm@51: $a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: $b = "big_acrylic_clear";
rlm@51: $a =~ s/PERL::INITIALCARD/$b/;
rlm@51: $b = &template("big_acrylic_clear");
rlm@51: $a =~ s/PERL-REPLACE::TEMPLATES/$b/; 
rlm@51: 
rlm@51: $b = &display("big_acrylic_clear");
rlm@51: $a =~ s/PERL-REPLACE::DISPLAY/$b/;
rlm@51: 
rlm@51: $initials = <<HERE ;
rlm@51: {
rlm@57: "Name":"My Name",
rlm@57: "Email":"email\@example.com",
rlm@57: "Phone": "(555)-555-5555", 
rlm@57: "Company": "Company",
rlm@57: "Website" : "http://www.example.com",
rlm@57: "Occupation" : "Occupation"
rlm@51: }
rlm@51: 
rlm@51: HERE
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: $b = &inputbox("big_acrylic_clear", $initials);
rlm@51: $a =~ s/PERL-REPLACE::INPUTBOX/$b/;
rlm@51: 
rlm@51: $b = &pokedex('big');
rlm@51: $a =~ s/PERL-REPLACE::POKEDEX/$b/;
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: #$b = &updateForm('fuck','12', '{}');
rlm@51: $a =~ s/PERL::INITIALVALUES/$initials/;
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: return $a
rlm@51: 
rlm@51: 
rlm@51: }
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: sub pokedex
rlm@51: {
rlm@51: 
rlm@51: 
rlm@51: $classic = <<HERE;
rlm@51: <h1>The Classic LaserKard.</h1>
rlm@51: Balanced and Complete.  The original LaserKard.  For those that wish to leave no stone unturned.  It's all there.
rlm@51: HERE
rlm@51: 
rlm@51: $bold = <<HERE;
rlm@51: <h1>The Bold Kard.</h1>
rlm@51: 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@51: HERE
rlm@51: 
rlm@51: $arrow = <<HERE;
rlm@51: <h1>The Arrow Kard.</h1>
rlm@51: Precise and Straightforward.  For those that seek to make a statement while being clear and concise. Straight as an arrow.
rlm@51: HERE
rlm@51: 
rlm@51: $direct = <<HERE;
rlm@51: <h1>The Direct Kard.</h1>
rlm@51: Thorough and Distinct.  For those that aim to demonstrate their professionalism with style.  Push the envelope.  Be Direct.
rlm@51: HERE
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: my %megahash = 
rlm@51: (
rlm@51: 
rlm@51: 'big' => $bold,
rlm@51: 
rlm@51: 'basic' => $arrow,
rlm@51: 
rlm@51: 'lines' => $direct,
rlm@51: 
rlm@51: 'classic' => $classic,
rlm@51: 
rlm@51: 'big_acrylic_clear' => $bold,
rlm@51: 
rlm@51: 'classic_acrylic_clear' => $classic,
rlm@51: 
rlm@51: 'basic_acrylic_clear'  => $arrow,
rlm@51: 
rlm@51: 'lines_acrylic_clear' => $direct
rlm@51: );
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: my $key = shift;
rlm@51: 
rlm@51: 
rlm@51: if (!$megahash{$key}){return $key;}
rlm@51: 
rlm@51: return $megahash{$key};
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: }
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: 
rlm@51: # this here function makes the paypal button go away so people know it's working!
rlm@51: sub vanish
rlm@51: {
rlm@51: return "";
rlm@51: 
rlm@51: 
rlm@51: }
rlm@51: 
rlm@51: 1;
rlm@51: 
rlm@51: