Mercurial > laserkard

comparison paypal/generate_paylists.pm @ 4:c96cb4e773e5 laserkard

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[svn r5] fully functional website.
author rlm
date Fri, 01 Jan 2010 01:19:49 -0500
parents
children 2979a76e3fdf
comparison
equal deleted inserted replaced
3:8261184f606b 4:c96cb4e773e5
1
2 package generate_paylists;
3
4
5 use Exporter;
6
7 our @ISA= qw( Exporter );
8 our @EXPORT = qw( paylist );
9
10
11
12
13 sub paylist
14 {
15
16 {#input stuff
17 my %args = (
18 TITLE => "Clarity LaserKard --- Classic Style",
19 NAME => 'classic_acrylic_clear',
20 FIELDS => ["Line 1", "Line 2","Line 3","Line 4","Line 5","Side"],
21 ADD_PENNY => 1,
22 COSTS_NAMES => ['40 cards -- $125', '3 cards -- $15'],
23 COSTS_CODE => ['40 cards @125.00', '3 cards @15.00'],
24 INITIAL_PRICE => '$125.00',
25 DEFAULTS => ['jbond@mi6.co.uk','123.456.7890','James Bond','MI6','Secret Agent','http://www.jamesbond.com'],
26 @_, # argument pair list goes here
27 );
28
29 @defaults = @{$args{DEFAULTS}};
30 $name = $args{NAME};
31 @fields = @{$args{FIELDS}};
32 @costs_names = @{$args{COSTS_NAMES}};
33 @costs_code = @{$args{COSTS_CODE}};
34 $penny = $args{ADD_PENNY};
35 $title = $args{TITLE};
36 $initial_price = $args{INITIAL_PRICE};
37
38 }
39
40 {#determine the total number of fields and payment options present:
41
42
43
44
45 $num_fields = $#fields +1;
46 $payment_opts = $#costs_names +1 ;
47
48 }
49
50 {#read in the file
51
52 {
53 local( $/, *FH ) ;
54 open( FH, "<BASE.paylist" ) or die "sudden flaming death\n";
55 $base = <FH>;
56 }
57
58 }
59
60 #The base file has the following options:
61
62 #PERL::TITLE x
63 #PERL::OPT0 -- PERL::OPT9 x
64 #PERL::PAYMENT x
65 #PERL::INPUT x
66 #PERL::PENNY x
67 #PERL::INITIAL_COST x
68
69
70 {#PERL::TITLE
71 $base =~ s/PERL::TITLE/$title/g;
72 }
73
74 {#PERL::OPT0 -- PERL::OPT9
75 for (0..9)
76 {
77 my $index = $_;
78 my $field = @fields[$index];
79 my $find = 'PERL::OPT'.$index;
80 my $replace = "value = \"$field\"";
81
82
83 if (!@fields[$index]){$replace = "";}
84
85 $base =~ s/$find/$replace/;
86 }
87 }
88
89 {#PERL::PAYMENT
90
91
92 my $start =
93 <<DDDDD;
94
95 <input type="radio" name = "whatev"
96
97 value="PERL::CODE" PERL::CHECKED
98 onclick = "ReadForm (this.form, false);"
99 onload = "ReadForm (this.form, false);" >
100 PERL::COST
101
102 <br>
103
104 DDDDD
105
106
107 $start2 = $start;
108
109 $start =~ s/PERL::COST/@costs_names[0]/;
110 $start =~ s/PERL::CODE/@costs_code[0]/;
111 $start =~ s/PERL::CHECKED/\"CHECKED\"/;
112
113
114
115 if (2 == $payment_opts)
116 {
117
118 $start2 =~ s/PERL::COST/@costs_names[1]/;
119 $start2 =~ s/PERL::CODE/@costs_code[1]/;
120 $start2 =~ s/PERL::CHECKED//;
121 $start = $start.$start2;
122
123 }
124
125 $base =~ s/PERL::PAYMENT/$start/;
126
127 }
128
129 {#PERL::INPUT
130
131
132 $start = <<OHYEAH;
133 <br>
134 PERL::OPT:&nbsp;&nbsp;
135 <input type="text" id="PERL::OPT" name="line_PERL::NUMb" size="20" value = "PERL::DEFAULT" ONFOCUS="clearDefault(this)">
136 <!-- -->
137 <br>
138 OHYEAH
139
140
141 my $input = "";
142
143 for (0..$#fields)
144 {
145 $rrr = $_+1;
146 $t = $start;
147 $t =~ s/PERL::NUM/$rrr/;
148 $t =~ s/PERL::OPT/$fields[$_]/g;
149 $t =~ s/PERL::DEFAULT/$defaults[$_]/;
150 $input = $input.$t;
151
152 }
153
154 $base =~ s/PERL::INPUT/$input/;
155
156 }
157
158 {#PERL::PENNY
159 my $penny_text;
160
161 if ($penny){
162 $penny_text =
163 <<PPP
164 <br>
165 <input type = "checkbox" onclick = "ReadForm (this.form, false);" value = "( +0.01 ^__^ )">
166 Add a penny! ^__^
167 <br>
168 PPP
169 }
170
171 $base =~ s/PERL::PENNY/$penny_text/;
172 }
173
174 {#PERL::INITIAL_COST
175 $base =~ s/PERL::INITIAL_COST/\"$initial_price\"/;
176 }
177
178
179
180 {#print the revised paylist out
181 open(OUT,">$name.paylist") or die "DEATH $!";
182 print OUT $base;
183 }
184
185
186
187 }
188
189 1;#stupidity