annotate paypal/generate_paylists.pm @ 104:a20199a24415 laserkard

test commit after upgrade
author Robert McIntyre <rlm@mit.edu>
date Fri, 06 Aug 2010 14:26:53 -0400
parents 8324f195ef36
children
rev   line source
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@57 18 DESC => "Clear, Scratch Resistant,<br> Laser-Etched 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@42 26 DEFAULTS => ['PERL::EMAIL','PERL','James Bond','MI6','Secret Agent','http://www.jamesbond.com'],
rlm@4 27 @_, # argument pair list goes here
rlm@4 28 );
rlm@40 29 $short_form = $args{SHORT_FORM};
rlm@24 30 $prod_name = $args{PRODUCT_NAME};
rlm@4 31 @defaults = @{$args{DEFAULTS}};
rlm@4 32 $name = $args{NAME};
rlm@4 33 @fields = @{$args{FIELDS}};
rlm@4 34 @costs_names = @{$args{COSTS_NAMES}};
rlm@4 35 @costs_code = @{$args{COSTS_CODE}};
rlm@4 36 $penny = $args{ADD_PENNY};
rlm@4 37 $title = $args{TITLE};
rlm@4 38 $initial_price = $args{INITIAL_PRICE};
rlm@32 39 $desc = $args{DESC};
rlm@4 40 }
rlm@4 41
rlm@4 42 {#determine the total number of fields and payment options present:
rlm@4 43
rlm@4 44
rlm@4 45
rlm@4 46
rlm@4 47 $num_fields = $#fields +1;
rlm@4 48 $payment_opts = $#costs_names +1 ;
rlm@4 49
rlm@4 50 }
rlm@4 51
rlm@4 52 {#read in the file
rlm@4 53
rlm@4 54 {
rlm@4 55 local( $/, *FH ) ;
rlm@4 56 open( FH, "<BASE.paylist" ) or die "sudden flaming death\n";
rlm@4 57 $base = <FH>;
rlm@4 58 }
rlm@4 59
rlm@4 60 }
rlm@4 61
rlm@4 62 #The base file has the following options:
rlm@4 63
rlm@4 64 #PERL::TITLE x
rlm@4 65 #PERL::OPT0 -- PERL::OPT9 x
rlm@4 66 #PERL::PAYMENT x
rlm@4 67 #PERL::INPUT x
rlm@4 68 #PERL::PENNY x
rlm@4 69 #PERL::INITIAL_COST x
rlm@4 70
rlm@4 71
rlm@4 72 {#PERL::TITLE
rlm@4 73 $base =~ s/PERL::TITLE/$title/g;
rlm@24 74 $base =~ s/PERL::PRODUCT-NAME/$prod_name/g;
rlm@32 75 $base =~ s/PERL::DESC/$desc/g;
rlm@4 76 }
rlm@4 77
rlm@4 78 {#PERL::OPT0 -- PERL::OPT9
rlm@4 79 for (0..9)
rlm@4 80 {
rlm@4 81 my $index = $_;
rlm@4 82 my $field = @fields[$index];
rlm@4 83 my $find = 'PERL::OPT'.$index;
rlm@4 84 my $replace = "value = \"$field\"";
rlm@4 85
rlm@4 86
rlm@4 87 if (!@fields[$index]){$replace = "";}
rlm@4 88
rlm@4 89 $base =~ s/$find/$replace/;
rlm@4 90 }
rlm@4 91 }
rlm@4 92
rlm@4 93 {#PERL::PAYMENT
rlm@4 94
rlm@4 95
rlm@57 96 my $init =
rlm@4 97 <<DDDDD;
rlm@4 98
rlm@4 99 <input type="radio" name = "whatev"
rlm@4 100
rlm@4 101 value="PERL::CODE" PERL::CHECKED
rlm@4 102 onclick = "ReadForm (this.form, false);"
rlm@4 103 onload = "ReadForm (this.form, false);" >
rlm@4 104 PERL::COST
rlm@4 105
rlm@4 106 <br>
rlm@4 107
rlm@4 108 DDDDD
rlm@4 109
rlm@4 110
rlm@4 111
rlm@57 112 $start = "";
rlm@57 113 for (0..$payment_opts-1)
rlm@4 114
rlm@57 115 {
rlm@57 116 $temp = $init;
rlm@4 117
rlm@4 118
rlm@57 119 $temp =~ s/PERL::COST/@costs_names[$_]/;
rlm@57 120 $temp =~ s/PERL::CODE/@costs_code[$_]/;
rlm@57 121 $temp =~ s/PERL::CHECKED/CHECKED/;
rlm@57 122 $start = $start.$temp;
rlm@4 123 }
rlm@4 124
rlm@4 125 $base =~ s/PERL::PAYMENT/$start/;
rlm@57 126 $start = $temp = $init ="";
rlm@4 127 }
rlm@4 128
rlm@4 129 {#PERL::INPUT
rlm@4 130
rlm@4 131
rlm@4 132 $start = <<OHYEAH;
rlm@4 133 <br>
rlm@46 134 PERL::OPT:&nbsp;&nbsp;<br>
rlm@49 135 <input type="text" MAXLENGTH = 30 name="line_PERL::NUMb" size="20" id="PERL::OPT"
rlm@44 136 ONFOCUS="clearDefault(this);" onKeyUp="stabForm('PERL::OPT');smallRedraw('PERL::SHORT', 'PERL::OPT');"
rlm@30 137
rlm@30 138 >
rlm@4 139 <!-- -->
rlm@4 140 <br>
rlm@4 141 OHYEAH
rlm@42 142 $start =~ s/PERL::SHORT/$short_form/g;
rlm@4 143
rlm@4 144 my $input = "";
rlm@4 145
rlm@4 146 for (0..$#fields)
rlm@4 147 {
rlm@4 148 $rrr = $_+1;
rlm@4 149 $t = $start;
rlm@4 150 $t =~ s/PERL::NUM/$rrr/;
rlm@4 151 $t =~ s/PERL::OPT/$fields[$_]/g;
rlm@4 152 $t =~ s/PERL::DEFAULT/$defaults[$_]/;
rlm@4 153 $input = $input.$t;
rlm@4 154
rlm@4 155 }
rlm@4 156
rlm@4 157 $base =~ s/PERL::INPUT/$input/;
rlm@4 158
rlm@4 159 }
rlm@4 160
rlm@4 161 {#PERL::PENNY
rlm@4 162 my $penny_text;
rlm@4 163
rlm@4 164 if ($penny){
rlm@4 165 $penny_text =
rlm@4 166 <<PPP
rlm@4 167 <br>
rlm@4 168 <input type = "checkbox" onclick = "ReadForm (this.form, false);" value = "( +0.01 ^__^ )">
rlm@4 169 Add a penny! ^__^
rlm@4 170 <br>
rlm@4 171 PPP
rlm@4 172 }
rlm@4 173
rlm@4 174 $base =~ s/PERL::PENNY/$penny_text/;
rlm@4 175 }
rlm@4 176
rlm@4 177 {#PERL::INITIAL_COST
rlm@4 178 $base =~ s/PERL::INITIAL_COST/\"$initial_price\"/;
rlm@4 179 }
rlm@4 180
rlm@4 181
rlm@4 182
rlm@4 183 {#print the revised paylist out
rlm@4 184 open(OUT,">$name.paylist") or die "DEATH $!";
rlm@4 185 print OUT $base;
rlm@4 186 }
rlm@4 187
rlm@4 188
rlm@4 189
rlm@4 190 }
rlm@4 191
rlm@4 192 1;#stupidity