Mercurial > laserkard
view paypal/generate_paylists.pm @ 62:3e5dd5e3566d laserkard
[svn r63] showed nick how to use SVN
author | rlm |
---|---|
date | Thu, 01 Apr 2010 19:19:08 -0400 |
parents | 8324f195ef36 |
children |
line wrap: on
line source
2 package generate_paylists;5 use Exporter;7 our @ISA= qw( Exporter );8 our @EXPORT = qw( paylist );13 sub paylist14 {16 {#input stuff17 my %args = (18 DESC => "Clear, Scratch Resistant,<br> Laser-Etched 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 here28 );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 file54 {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 x65 #PERL::OPT0 -- PERL::OPT9 x66 #PERL::PAYMENT x67 #PERL::INPUT x68 #PERL::PENNY x69 #PERL::INITIAL_COST x72 {#PERL::TITLE73 $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::OPT979 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::PAYMENT96 my $init =97 <<DDDDD;99 <input type="radio" name = "whatev"101 value="PERL::CODE" PERL::CHECKED102 onclick = "ReadForm (this.form, false);"103 onload = "ReadForm (this.form, false);" >104 PERL::COST106 <br>108 DDDDD112 $start = "";113 for (0..$payment_opts-1)115 {116 $temp = $init;119 $temp =~ s/PERL::COST/@costs_names[$_]/;120 $temp =~ s/PERL::CODE/@costs_code[$_]/;121 $temp =~ s/PERL::CHECKED/CHECKED/;122 $start = $start.$temp;123 }125 $base =~ s/PERL::PAYMENT/$start/;126 $start = $temp = $init ="";127 }129 {#PERL::INPUT132 $start = <<OHYEAH;133 <br>134 PERL::OPT: <br>135 <input type="text" MAXLENGTH = 30 name="line_PERL::NUMb" size="20" id="PERL::OPT"136 ONFOCUS="clearDefault(this);" onKeyUp="stabForm('PERL::OPT');smallRedraw('PERL::SHORT', 'PERL::OPT');"138 >139 <!-- -->140 <br>141 OHYEAH142 $start =~ s/PERL::SHORT/$short_form/g;144 my $input = "";146 for (0..$#fields)147 {148 $rrr = $_+1;149 $t = $start;150 $t =~ s/PERL::NUM/$rrr/;151 $t =~ s/PERL::OPT/$fields[$_]/g;152 $t =~ s/PERL::DEFAULT/$defaults[$_]/;153 $input = $input.$t;155 }157 $base =~ s/PERL::INPUT/$input/;159 }161 {#PERL::PENNY162 my $penny_text;164 if ($penny){165 $penny_text =166 <<PPP167 <br>168 <input type = "checkbox" onclick = "ReadForm (this.form, false);" value = "( +0.01 ^__^ )">169 Add a penny! ^__^170 <br>171 PPP172 }174 $base =~ s/PERL::PENNY/$penny_text/;175 }177 {#PERL::INITIAL_COST178 $base =~ s/PERL::INITIAL_COST/\"$initial_price\"/;179 }183 {#print the revised paylist out184 open(OUT,">$name.paylist") or die "DEATH $!";185 print OUT $base;186 }190 }192 1;#stupidity