view paypal/generate_paylists.pm @ 44:1045db9799e3 laserkard

[svn r45] Greatly Enhanced Responsiveness of the website.
author rlm
date Thu, 28 Jan 2010 04:10:44 -0500
parents ef8615de8a9c
children 26c2b3ad21c7
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 => ['PERL::EMAIL','PERL','James Bond','MI6','Secret Agent','http://www.jamesbond.com'],
27 @_, # argument pair list goes here
28 );
29 $short_form = $args{SHORT_FORM};
30 $prod_name = $args{PRODUCT_NAME};
31 @defaults = @{$args{DEFAULTS}};
32 $name = $args{NAME};
33 @fields = @{$args{FIELDS}};
34 @costs_names = @{$args{COSTS_NAMES}};
35 @costs_code = @{$args{COSTS_CODE}};
36 $penny = $args{ADD_PENNY};
37 $title = $args{TITLE};
38 $initial_price = $args{INITIAL_PRICE};
39 $desc = $args{DESC};
40 }
42 {#determine the total number of fields and payment options present:
47 $num_fields = $#fields +1;
48 $payment_opts = $#costs_names +1 ;
50 }
52 {#read in the file
54 {
55 local( $/, *FH ) ;
56 open( FH, "<BASE.paylist" ) or die "sudden flaming death\n";
57 $base = <FH>;
58 }
60 }
62 #The base file has the following options:
64 #PERL::TITLE x
65 #PERL::OPT0 -- PERL::OPT9 x
66 #PERL::PAYMENT x
67 #PERL::INPUT x
68 #PERL::PENNY x
69 #PERL::INITIAL_COST x
72 {#PERL::TITLE
73 $base =~ s/PERL::TITLE/$title/g;
74 $base =~ s/PERL::PRODUCT-NAME/$prod_name/g;
75 $base =~ s/PERL::DESC/$desc/g;
76 }
78 {#PERL::OPT0 -- PERL::OPT9
79 for (0..9)
80 {
81 my $index = $_;
82 my $field = @fields[$index];
83 my $find = 'PERL::OPT'.$index;
84 my $replace = "value = \"$field\"";
87 if (!@fields[$index]){$replace = "";}
89 $base =~ s/$find/$replace/;
90 }
91 }
93 {#PERL::PAYMENT
96 my $start =
97 <<DDDDD;
99 <input type="radio" name = "whatev"
101 value="PERL::CODE" PERL::CHECKED
102 onclick = "ReadForm (this.form, false);"
103 onload = "ReadForm (this.form, false);" >
104 PERL::COST
106 <br>
108 DDDDD
111 $start2 = $start;
113 $start =~ s/PERL::COST/@costs_names[0]/;
114 $start =~ s/PERL::CODE/@costs_code[0]/;
115 $start =~ s/PERL::CHECKED/CHECKED/;
119 if (2 == $payment_opts)
120 {
122 $start2 =~ s/PERL::COST/@costs_names[1]/;
123 $start2 =~ s/PERL::CODE/@costs_code[1]/;
124 $start2 =~ s/PERL::CHECKED//;
125 $start = $start.$start2;
127 }
129 $base =~ s/PERL::PAYMENT/$start/;
131 }
133 {#PERL::INPUT
136 $start = <<OHYEAH;
137 <br>
138 PERL::OPT:&nbsp;&nbsp;
139 <input type="text" name="line_PERL::NUMb" size="20" id="PERL::OPT"
140 ONFOCUS="clearDefault(this);" onKeyUp="stabForm('PERL::OPT');smallRedraw('PERL::SHORT', 'PERL::OPT');"
142 >
143 <!-- -->
144 <br>
145 OHYEAH
146 $start =~ s/PERL::SHORT/$short_form/g;
148 my $input = "";
150 for (0..$#fields)
151 {
152 $rrr = $_+1;
153 $t = $start;
154 $t =~ s/PERL::NUM/$rrr/;
155 $t =~ s/PERL::OPT/$fields[$_]/g;
156 $t =~ s/PERL::DEFAULT/$defaults[$_]/;
157 $input = $input.$t;
159 }
161 $base =~ s/PERL::INPUT/$input/;
163 }
165 {#PERL::PENNY
166 my $penny_text;
168 if ($penny){
169 $penny_text =
170 <<PPP
171 <br>
172 <input type = "checkbox" onclick = "ReadForm (this.form, false);" value = "( +0.01 ^__^ )">
173 Add a penny! ^__^
174 <br>
175 PPP
176 }
178 $base =~ s/PERL::PENNY/$penny_text/;
179 }
181 {#PERL::INITIAL_COST
182 $base =~ s/PERL::INITIAL_COST/\"$initial_price\"/;
183 }
187 {#print the revised paylist out
188 open(OUT,">$name.paylist") or die "DEATH $!";
189 print OUT $base;
190 }
194 }
196 1;#stupidity