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