Mercurial > laserkard

annotate paypal/generate_paylists.pm @ 31:d269b63b4a54 laserkard

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