view paypal/generate_paylists.pm @ 37:021a9ab1ed5b laserkard

[svn r38] added echo.pl, a test program for the backend of the website
author rlm
date Sun, 24 Jan 2010 09:37:47 -0500
parents 0deeb2d5d1db
children 1ac1409ea68c
line wrap: on
line source

2 package generate_paylists;
5 use Exporter;
7 our @ISA= qw( Exporter );
8 our @EXPORT = qw( paylist );
13 sub paylist
14 {
16 {#input stuff
17 my %args = (
18 DESC => "Laser-Etched Clear Acrylic",
19 TITLE => "Clarity LaserKard --- Classic Style",
20 NAME => 'classic_acrylic_clear',
21 FIELDS => ["Line 1", "Line 2","Line 3","Line 4","Line 5","Side"],
22 ADD_PENNY => 1,
23 COSTS_NAMES => ['40 cards -- $125', '3 cards -- $15'],
24 COSTS_CODE => ['40 cards @125.00', '3 cards @15.00'],
25 INITIAL_PRICE => '$125.00',
26 DEFAULTS => ['jbond@mi6.co.uk','123.456.7890','James Bond','MI6','Secret Agent','http://www.jamesbond.com'],
27 @_, # argument pair list goes here
28 );
29 $prod_name = $args{PRODUCT_NAME};
30 @defaults = @{$args{DEFAULTS}};
31 $name = $args{NAME};
32 @fields = @{$args{FIELDS}};
33 @costs_names = @{$args{COSTS_NAMES}};
34 @costs_code = @{$args{COSTS_CODE}};
35 $penny = $args{ADD_PENNY};
36 $title = $args{TITLE};
37 $initial_price = $args{INITIAL_PRICE};
38 $desc = $args{DESC};
39 }
41 {#determine the total number of fields and payment options present:
46 $num_fields = $#fields +1;
47 $payment_opts = $#costs_names +1 ;
49 }
51 {#read in the file
53 {
54 local( $/, *FH ) ;
55 open( FH, "<BASE.paylist" ) or die "sudden flaming death\n";
56 $base = <FH>;
57 }
59 }
61 #The base file has the following options:
63 #PERL::TITLE x
64 #PERL::OPT0 -- PERL::OPT9 x
65 #PERL::PAYMENT x
66 #PERL::INPUT x
67 #PERL::PENNY x
68 #PERL::INITIAL_COST x
71 {#PERL::TITLE
72 $base =~ s/PERL::TITLE/$title/g;
73 $base =~ s/PERL::PRODUCT-NAME/$prod_name/g;
74 $base =~ s/PERL::DESC/$desc/g;
75 }
77 {#PERL::OPT0 -- PERL::OPT9
78 for (0..9)
79 {
80 my $index = $_;
81 my $field = @fields[$index];
82 my $find = 'PERL::OPT'.$index;
83 my $replace = "value = \"$field\"";
86 if (!@fields[$index]){$replace = "";}
88 $base =~ s/$find/$replace/;
89 }
90 }
92 {#PERL::PAYMENT
95 my $start =
96 <<DDDDD;
98 <input type="radio" name = "whatev"
100 value="PERL::CODE" PERL::CHECKED
101 onclick = "ReadForm (this.form, false);"
102 onload = "ReadForm (this.form, false);" >
103 PERL::COST
105 <br>
107 DDDDD
110 $start2 = $start;
112 $start =~ s/PERL::COST/@costs_names[0]/;
113 $start =~ s/PERL::CODE/@costs_code[0]/;
114 $start =~ s/PERL::CHECKED/CHECKED/;
118 if (2 == $payment_opts)
119 {
121 $start2 =~ s/PERL::COST/@costs_names[1]/;
122 $start2 =~ s/PERL::CODE/@costs_code[1]/;
123 $start2 =~ s/PERL::CHECKED//;
124 $start = $start.$start2;
126 }
128 $base =~ s/PERL::PAYMENT/$start/;
130 }
132 {#PERL::INPUT
135 $start = <<OHYEAH;
136 <br>
137 PERL::OPT:&nbsp;&nbsp;
138 <input type="text" id="PERL::OPT" name="line_PERL::NUMb" size="20" value = "PERL::DEFAULT" ONFOCUS="clearDefault(this)"
139 onKeyUp="
140 tt.remove();
142 var font_size = 30;
144 tt = raphe.print(0, 145, value, raphe.getFont('HelveticaNeue', 700), font_size);
145 tt.attr('stroke', '#f00');
146 tt.attr('fill', 'TRANSPARENT');
147 var c = tt.getBBox().width;
148 tt.translate((502 - c)/2,0);
155 //document.write( c );
161 "
163 >
164 <!-- -->
165 <br>
166 OHYEAH
169 my $input = "";
171 for (0..$#fields)
172 {
173 $rrr = $_+1;
174 $t = $start;
175 $t =~ s/PERL::NUM/$rrr/;
176 $t =~ s/PERL::OPT/$fields[$_]/g;
177 $t =~ s/PERL::DEFAULT/$defaults[$_]/;
178 $input = $input.$t;
180 }
182 $base =~ s/PERL::INPUT/$input/;
184 }
186 {#PERL::PENNY
187 my $penny_text;
189 if ($penny){
190 $penny_text =
191 <<PPP
192 <br>
193 <input type = "checkbox" onclick = "ReadForm (this.form, false);" value = "( +0.01 ^__^ )">
194 Add a penny! ^__^
195 <br>
196 PPP
197 }
199 $base =~ s/PERL::PENNY/$penny_text/;
200 }
202 {#PERL::INITIAL_COST
203 $base =~ s/PERL::INITIAL_COST/\"$initial_price\"/;
204 }
208 {#print the revised paylist out
209 open(OUT,">$name.paylist") or die "DEATH $!";
210 print OUT $base;
211 }
215 }
217 1;#stupidity