Mercurial > laserkard

     1 package Laserkard;

     2 

     3 use List::Util qw(first max maxstr min minstr reduce shuffle sum);

     4 use Storable;

     5 use CGI::Ajax;

     6 use CGI;

     7 use JSON;

     8 use Laserkard;

     9 use base 'Exporter';

    10 

    11 our @EXPORT = 

    12 qw(

    13 material

    14 template 

    15 inputbox

    16 display

    17 change_rules

    18 vanish

    19 updateForm

    20 cardType

    21 );

    22 

    23 

    24 

    25 

    26 

    27 sub cardType

    28 {

    29 

    30 return $_[0];

    31 	

    32 }

    33 

    34  

    35 

    36 sub updateForm

    37 

    38 {

    39 	

    40 	

    41 	$key = shift;

    42 	$value = shift;

    43 	$hashString = shift;

    44 	

    45 	$perl_hash  = decode_json $hashString;

    46 

    47 	%fieldHash = %$perl_hash;

    48 

    49 

    50 	$fieldHash{$key} = $value;

    51 	$ref = \%fieldHash;

    52 	

    53 	$utf8_encoded_json_text = encode_json  $ref ;

    54 	return $utf8_encoded_json_text;

    55 

    56 }

    57 

    58 

    59 

    60 

    61 sub material{

    62 	

    63 	$newvar = shift;

    64 	

    65 	my $t = $newvar;

    66 	

    67 	$newvar =~ m/([^_]*)_/;

    68 	$newvar = $1;

    69 	

    70 	#return (($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked');

    71 	

    72 	#$y = "$t<br>".(($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked')."

    73 	

    74 	{

    75     local( $/, *FH ) ;

    76     open( FH, "<./buy_pieces/materials2.html" ) or die "sudden flaming death\n";

    77     $y = <FH>;

    78 	}

    79 	

    80 	@symbols = qw(PERL::ACRYLIC_CLEAR PERL::ACRYLIC_BLUE PERL::ACRYLIC_GREEN PERL::ALUMINUM_RED PERL::ALUMINUM_BLUE PERL::ALUMINUM_GREEN PERL::ALUMINUM_BLACK);

    81 	

    82 	for (@symbols)

    83 	{

    84 	$c = $_;

    85 	$c =~ s/PERL:://;

    86 	$c =~ tr/[A-Z]/[a-z]/;

    87 	$c =~ s/^/_/;

    88 	

    89 	$b = '"'.$newvar.$c.'"'.(($t =~ m/$c/) ? '  CHECKED ' : '');

    90 	$y =~ s/$_/$b/; 

    91 	}

    92 	

    93 

    94 	$first = shift;

    95 	if ($first){  $y =~ s/display[^;]*;//g; }

    96 	

    97 		

    98 	

    99 	return $y;

   100 		

   101 	

   102 }

   103 

   104 

   105 

   106 sub template

   107 {

   108 	

   109 $all = shift;

   110 $all =~ m/([^_]*)_(.*)/;

   111 

   112 $materialcolor = $2;

   113 $style = $1;

   114 #here is where we handle important drawing commands relating to the cards.

   115 

   116 

   117 	

   118 $r =  <<HERE;

   119 <div id = "i_templates"><div class = 'ttyl'> <titletron>Select Style.</titletron></div>

   120 <div id = 'stupid'>

   121 

   122 

   123 <input TYPE="image" src = "./images/templates/big_$materialcolor.jpg" 	

   124 onmouseover="pokedex('big_$materialcolor');"

   125 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"

   126 

   127 

   128  	

   129 onclick=

   130 "display(['template2'], ['display']); 

   131 inputbox(['template2', 'formValues'], ['inputbox']);

   132 material(['template2'], ['materials']);

   133 cardType(['template2'], ['currentSpec']);

   134 redraw('bold');" 

   135 ID="template2" NAME="template2" VALUE="big_$materialcolor">

   136 <br>

   137 

   138   

   139 

   140 <input TYPE="image" src = "./images/templates/basic_$materialcolor.jpg"

   141 onmouseover="pokedex('basic_$materialcolor');" 

   142 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"

   143 onclick=

   144 "display(['template3'], ['display']); 

   145 inputbox(['template3', 'formValues'], ['inputbox']);

   146 material(['template3'], ['materials']);

   147 cardType(['template3'], ['currentSpec']);

   148 redraw('arrow');" 

   149 ID="template3" NAME="template3" VALUE="basic_$materialcolor"          ><br>

   150 

   151  

   152 

   153 <input TYPE="image" src = "./images/templates/classic_$materialcolor.jpg"  

   154 onmouseover="pokedex('classic_$materialcolor');" 

   155 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"

   156 onclick=

   157 "display(['template1'], ['display']); 

   158 inputbox(['template1', 'formValues'], ['inputbox']);

   159 material(['template1'], ['materials']);

   160 cardType(['template1'], ['currentSpec']);

   161 redraw('classic');" 

   162 ID="template1" NAME="template1" VALUE="classic_$materialcolor"    ><br>

   163 

   164  

   165 

   166 <input TYPE="image" src = "./images/templates/lines_$materialcolor.jpg" 

   167 onmouseover="pokedex('lines_$materialcolor');" 	

   168 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"

   169 onclick=

   170 "display(['template4'], ['display']); 

   171 inputbox(['template4', 'formValues'], ['inputbox']);

   172 material(['template4'], ['materials']);

   173 cardType(['template4'], ['currentSpec']);

   174 redraw('direct');" 

   175 ID="template4" NAME="template4" VALUE="lines_$materialcolor"           > 

   176 

   177 	</div>

   178 	</div>

   179 

   180 HERE

   181 

   182 

   183 %shankHash = 

   184 (

   185 

   186 big => template2,  

   187 basic => template3,

   188 classic => template1,

   189 lines  => template4

   190 );

   191 

   192 $target = $shankHash{$style};

   193 

   194 

   195 

   196 

   197 #$r =~ s/inputbox\(\['$target'\], \['inputbox'\]\)\;//;

   198 

   199 

   200 

   201 

   202 

   203 return $r;

   204 }

   205 

   206 

   207 

   208 

   209 sub inputbox

   210 {

   211 

   212 #grab the type of template we'll be using <<<<

   213 	$type = shift;

   214 	

   215 	$hashString = shift;

   216 	#return $hashString;

   217 	

   218 	$perl_hash  = decode_json $hashString;

   219 

   220 	%fieldHash = %$perl_hash;

   221  

   222 

   223 # we have to care about both the type of template and the material and the color. these are stored in $type>>>>

   224 

   225 #Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template.

   226 #will probaly eventually create a script to automate the generation of these files.

   227 

   228 

   229 #take care of everythign but acrylic clear type

   230 

   231   {

   232     local( $/, *FH ) ;

   233     open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";

   234     $z = <FH>;

   235   }

   236 

   237 

   238 #every type has it's own associated paylist file the contains the things we need

   239 

   240 $z = <<HERE . $z;

   241 <div id = "whatever" onmouseover = "pokedex(document.getElementById('currentSpec').innerHTML);">

   242 HERE

   243 

   244 

   245 

   246 

   247 $z = $z.'</div>';

   248 

   249 

   250 foreach my $key ( keys %fieldHash )

   251 {

   252 

   253 my $replace  = $fieldHash{$key};

   254 

   255 #id="Name" value = "PERL::NAME" 

   256 

   257 

   258 $z =~ s/id="$key"/id="$key" value = "$replace"/g;

   259 

   260 

   261 }

   262 

   263 

   264 return $z;

   265 

   266 

   267 

   268 

   269 

   270 }

   271 

   272 

   273 

   274 

   275 sub display

   276 {

   277 	$all = shift;

   278 	

   279 	

   280 	#~ 

   281 	#~ $t = <<HERE;

   282 	#~ <image src = "./images/display/PERL::PIC.jpg" 	onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">

   283 	#~ 

   284 	#~ <div id = overlay>

   285 #~ 

   286 #~ 

   287 	#~ </div>

   288 	#~ 

   289 #~ HERE

   290 #~ 

   291 #~ 

   292 #~ 

   293 #~ $t =~ s/PERL::PIC/$all/g;

   294 

   295 	$t = <<HERE;

   296 	<image src = "./images/display/blank.jpg" 	

   297 	onmouseover = "pokedex(document.getElementById('currentSpec').innerHTML);"

   298 	>

   299 	

   300 	<div id = overlay>

   301 

   302 

   303 	</div>

   304 	

   305 HERE

   306 	

   307 	return $t;

   308 	

   309 }

   310 

   311 

   312 sub genBuy

   313 

   314 {

   315 return gen("buy.html");	

   316 	

   317 }

   318 

   319 

   320 sub genEcho

   321 {

   322 	

   323 return gen("echo.html");

   324 	

   325 }

   326 

   327 

   328 sub gen

   329 {

   330 	

   331 	my $target = shift;

   332 	

   333   {

   334     local( $/, *FH ) ;

   335     open( FH, "<./$target" ) or die "sudden flaming death\n";

   336     $a = <FH>;

   337    }

   338 

   339   {

   340     local( $/, *FH ) ;

   341     open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";

   342     $b = <FH>;

   343    }

   344 

   345   {

   346     local( $/, *FH ) ;

   347     open( FH, "<./cardDefinitions.JSON" ) or die "sudden flaming death\n";

   348     $c = <FH>;

   349    }

   350 

   351 $a =~s/PERL::DEFS/$c/;

   352 

   353 

   354 

   355 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)

   356 $b = &material("void_acrylic_clear",1);

   357 $a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)

   358 

   359 

   360 

   361 $b = "big_acrylic_clear";

   362 $a =~ s/PERL::INITIALCARD/$b/;

   363 $b = &template("big_acrylic_clear");

   364 $a =~ s/PERL-REPLACE::TEMPLATES/$b/; 

   365 

   366 $b = &display("big_acrylic_clear");

   367 $a =~ s/PERL-REPLACE::DISPLAY/$b/;

   368 

   369 $initials = <<HERE ;

   370 {

   371 "Name":"James Bond",

   372 "Email":"jbond\@mi6.co.uk",

   373 "Phone": "123.456.7890", 

   374 "Company": "MI6",

   375 "Website" : "http://jamesbond.com",

   376 "Occupation" : "Secret Agent"

   377 }

   378 

   379 HERE

   380 

   381 

   382 

   383 $b = &inputbox("big_acrylic_clear", $initials);

   384 $a =~ s/PERL-REPLACE::INPUTBOX/$b/;

   385 

   386 $b = &pokedex('big');

   387 $a =~ s/PERL-REPLACE::POKEDEX/$b/;

   388 

   389 

   390 

   391 #$b = &updateForm('fuck','12', '{}');

   392 $a =~ s/PERL::INITIALVALUES/$initials/;

   393 

   394 

   395 

   396 return $a

   397 

   398 

   399 }

   400 

   401 

   402 

   403 sub pokedex

   404 {

   405 

   406 

   407 $classic = <<HERE;

   408 <h1>The Classic LaserKard.</h1>

   409 Balanced and Complete.  The original LaserKard.  For those that wish to leave no stone unturned.  It's all there.

   410 HERE

   411 

   412 $bold = <<HERE;

   413 <h1>The Bold Kard.</h1>

   414 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.

   415 HERE

   416 

   417 $arrow = <<HERE;

   418 <h1>The Arrow Kard.</h1>

   419 Precise and Straightforward.  For those that seek to make a statement while being clear and concise. Straight as an arrow.

   420 HERE

   421 

   422 $direct = <<HERE;

   423 <h1>The Direct Kard.</h1>

   424 Thorough and Distinct.  For those that aim to demonstrate their professionalism with style.  Push the envelope.  Be Direct.

   425 HERE

   426 

   427 

   428 

   429 my %megahash = 

   430 (

   431 

   432 'big' => $bold,

   433 

   434 'basic' => $arrow,

   435 

   436 'lines' => $direct,

   437 

   438 'classic' => $classic,

   439 

   440 'big_acrylic_clear' => $bold,

   441 

   442 'classic_acrylic_clear' => $classic,

   443 

   444 'basic_acrylic_clear'  => $arrow,

   445 

   446 'lines_acrylic_clear' => $direct

   447 );

   448 

   449 

   450 

   451 my $key = shift;

   452 

   453 

   454 if (!$megahash{$key}){return $key;}

   455 

   456 return $megahash{$key};

   457 

   458 

   459 

   460 

   461 }

   462 

   463 

   464 

   465 

   466 

   467 

   468 

   469 

   470 # this here function makes the paypal button go away so people know it's working!

   471 sub vanish

   472 {

   473 return "";

   474 

   475 

   476 }

   477 

   478 1;

   479 

   480
author	rlm
date	Wed, 03 Feb 2010 03:14:09 -0500
parents
children	8324f195ef36