Mercurial > laserkard

annotate buy.pl @ 22:3298256dd459 laserkard

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[svn r23] did much cosmetic work.
author rlm
date Sun, 03 Jan 2010 03:36:21 -0500
parents 896afe03bc67
children 707d202f58b1
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@0 8
rlm@0 9
rlm@0 10
rlm@0 11 my $q = new CGI;
rlm@0 12
rlm@0 13
rlm@0 14
rlm@0 15 my %hash = (
rlm@0 16
rlm@0 17 'material' => \&material,
rlm@2 18 'pokedex' => \&pokedex,
rlm@0 19 'template' => \&template,
rlm@0 20 'inputbox' => \&inputbox,
rlm@0 21 'display' => \&display,
rlm@0 22 'change_rules' => \&change_rules);
rlm@0 23
rlm@0 24
rlm@0 25
rlm@0 26 my $pjx = CGI::Ajax->new(%hash);
rlm@0 27 #$pjx->JSDEBUG(1);
rlm@0 28 #$pjx->DEBUG(1);
rlm@0 29
rlm@0 30 print $pjx->build_html($q,\&gen); # this outputs the html for the page
rlm@0 31
rlm@0 32
rlm@0 33
rlm@0 34
rlm@0 35
rlm@0 36 sub material{
rlm@0 37
rlm@0 38 $newvar = shift;
rlm@0 39
rlm@0 40 my $t = $newvar;
rlm@0 41
rlm@0 42 $newvar =~ m/([^_]*)_/;
rlm@0 43 $newvar = $1;
rlm@0 44
rlm@0 45 #return (($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked');
rlm@0 46
rlm@0 47 #$y = "$t<br>".(($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked')."
rlm@2 48
rlm@2 49 {
rlm@2 50 local( $/, *FH ) ;
rlm@2 51 open( FH, "<./buy_pieces/materials2.html" ) or die "sudden flaming death\n";
rlm@2 52 $y = <FH>;
rlm@2 53 }
rlm@2 54
rlm@2 55 @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 56
rlm@2 57 for (@symbols)
rlm@2 58 {
rlm@2 59 $c = $_;
rlm@2 60 $c =~ s/PERL:://;
rlm@2 61 $c =~ tr/[A-Z]/[a-z]/;
rlm@2 62 $c =~ s/^/_/;
rlm@2 63
rlm@2 64 $b = '"'.$newvar.$c.'"'.(($t =~ m/$c/) ? ' CHECKED ' : '');
rlm@2 65 $y =~ s/$_/$b/;
rlm@2 66 }
rlm@2 67
rlm@2 68
rlm@2 69 $first = shift;
rlm@2 70 if ($first){ $y =~ s/display[^;]*;//g; }
rlm@2 71
rlm@0 72
rlm@0 73
rlm@0 74 return $y;
rlm@0 75
rlm@0 76
rlm@0 77 }
rlm@0 78
rlm@0 79
rlm@0 80
rlm@0 81 sub template
rlm@0 82 {
rlm@0 83
rlm@0 84 $all = shift;
rlm@0 85 $all =~ m/_(.*)/;
rlm@0 86
rlm@0 87 $materialcolor = $1;
rlm@0 88
rlm@0 89
rlm@5 90 $r = "<div id = \"i_templates\">Templates:<br>
rlm@22 91
rlm@22 92 <input TYPE=\"image\" src = \"./images/templates/big_$materialcolor.jpg\" onmouseover=\"pokedex([\'args__big\'],[\'pokedex\']);\" onclick=\"display([\'template2\'], [\'display\']); inputbox([\'template2\'], [\'inputbox\']);material([\'template2\'], [\'materials\']);\" ID=\"template2\" NAME=\"template2\" VALUE=\"big_$materialcolor\" > <br>
rlm@22 93
rlm@22 94 <input TYPE=\"image\" src = \"./images/templates/basic_$materialcolor.jpg\" onmouseover=\"pokedex([\'args__basic\'],['pokedex\']);\" onclick=\"display([\'template3\'], [\'display\']); inputbox([\'template3\'], [\'inputbox\']);material([\'template3\'], [\'materials\']);\" ID=\"template3\" NAME=\"template3\" VALUE=\"basic_$materialcolor\" ><br>
rlm@22 95
rlm@22 96 <input TYPE=\"image\" src = \"./images/templates/classic_$materialcolor.jpg\" onmouseover=\"pokedex([\'args__classic\'],[\'pokedex\']);\" onclick=\"display([\'template1\'], [\'display\']); inputbox([\'template1\'], [\'inputbox\']);material([\'template1\'], [\'materials\']);\" ID=\"template1\" NAME=\"template1\" VALUE=\"classic_$materialcolor\" ><br>
rlm@22 97
rlm@22 98 <input TYPE=\"image\" src = \"./images/templates/lines_$materialcolor.jpg\" onmouseover=\"pokedex([\'args__lines\'],[\'pokedex\']);\" onclick=\"display([\'template4\'], [\'display\']); inputbox([\'template4\'], [\'inputbox\']);material([\'template4\'], [\'materials\']);\" ID=\"template4\" NAME=\"template4\" VALUE=\"lines_$materialcolor\" >
rlm@5 99 </div>
rlm@0 100
rlm@0 101 ";
rlm@0 102
rlm@0 103 return $r;
rlm@0 104 }
rlm@0 105
rlm@0 106
rlm@0 107
rlm@0 108
rlm@0 109 sub inputbox
rlm@0 110 {
rlm@0 111
rlm@0 112 #grab the type of template we'll be using <<<<
rlm@0 113 $type = shift;
rlm@0 114 # return $type;
rlm@0 115 # we have to care about both the type of template and the material and the color. these are stored in $type>>>>
rlm@0 116
rlm@0 117 #Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template.
rlm@0 118 #will probaly eventually create a script to automate the generation of these files.
rlm@0 119
rlm@0 120
rlm@0 121 #take care of everythign but acrylic clear type
rlm@2 122
rlm@2 123
rlm@2 124
rlm@2 125 {
rlm@2 126 local( $/, *FH ) ;
rlm@2 127 open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";
rlm@2 128 $z = <FH>;
rlm@2 129 }
rlm@0 130
rlm@0 131
rlm@0 132 #every type has it's own associated paylist file the contains the things we need
rlm@2 133
rlm@4 134 $z = '<div id = "whatever" onmouseover='."\"pokedex([\'args__$type\'],[\'pokedex\']);\"".$z.'</div>';
rlm@2 135 return $z;
rlm@2 136
rlm@2 137
rlm@0 138
rlm@0 139
rlm@0 140
rlm@0 141 }
rlm@0 142
rlm@0 143
rlm@0 144
rlm@0 145
rlm@0 146
rlm@0 147
rlm@0 148
rlm@0 149
rlm@0 150 sub display
rlm@0 151 {
rlm@0 152 $all = shift;
rlm@0 153
rlm@0 154
rlm@0 155
rlm@2 156 $t ="
rlm@16 157 <input TYPE=\"image\" src = \"./images/display/$all.jpg\" >
rlm@0 158 ";
rlm@0 159 return $t;
rlm@0 160
rlm@0 161 }
rlm@0 162
rlm@0 163
rlm@0 164
rlm@0 165
rlm@0 166 sub gen
rlm@0 167 {
rlm@0 168 {
rlm@0 169 local( $/, *FH ) ;
rlm@0 170 open( FH, "<./buy.html" ) or die "sudden flaming death\n";
rlm@0 171 $a = <FH>;
rlm@0 172 }
rlm@0 173
rlm@0 174 {
rlm@0 175 local( $/, *FH ) ;
rlm@0 176 open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";
rlm@0 177 $b = <FH>;
rlm@0 178 }
rlm@0 179
rlm@2 180
rlm@2 181
rlm@2 182 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)
rlm@2 183 $b = &material("void_acrylic_clear",1);
rlm@2 184 $a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)
rlm@22 185 $b = &template("big_acrylic_clear");
rlm@2 186
rlm@16 187 #$a =~ s/PERL-REPLACE::TEMPLATES//;
rlm@16 188 $a =~ s/PERL-REPLACE::TEMPLATES/$b/; #comment out one or the other!
rlm@2 189
rlm@22 190 $b = &display("big_acrylic_clear");
rlm@22 191 $a =~ s/PERL-REPLACE::DISPLAY/$b/;
rlm@22 192
rlm@22 193 $b = &inputbox("big_acrylic_clear");
rlm@22 194 $a =~ s/PERL-REPLACE::INPUTBOX/$b/;
rlm@2 195
rlm@0 196
rlm@0 197 return $a
rlm@0 198
rlm@0 199
rlm@2 200 }
rlm@0 201
rlm@0 202
rlm@2 203
rlm@2 204 sub pokedex
rlm@2 205 {
rlm@2 206
rlm@2 207 my $key = shift;
rlm@2 208
rlm@2 209 return $key;
rlm@2 210
rlm@2 211
rlm@2 212 }