diff paypal/generate_paylists.pm @ 4:c96cb4e773e5 laserkard

[svn r5] fully functional website.
author rlm
date Fri, 01 Jan 2010 01:19:49 -0500
parents
children 2979a76e3fdf
line wrap: on
line diff
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/paypal/generate_paylists.pm	Fri Jan 01 01:19:49 2010 -0500
     1.3 @@ -0,0 +1,189 @@
     1.4 +
     1.5 +package generate_paylists;
     1.6 +
     1.7 +
     1.8 +use Exporter;
     1.9 +
    1.10 +our @ISA= qw( Exporter );
    1.11 +our @EXPORT = qw( paylist );
    1.12 +
    1.13 +
    1.14 +
    1.15 +
    1.16 +sub paylist 
    1.17 +{
    1.18 +	
    1.19 +{#input stuff
    1.20 +    my %args = (
    1.21 +		TITLE  => "Clarity LaserKard --- Classic Style",
    1.22 +        NAME   => 'classic_acrylic_clear', 
    1.23 +        FIELDS      => ["Line 1", "Line 2","Line 3","Line 4","Line 5","Side"],
    1.24 +        ADD_PENNY       => 1, 
    1.25 +        COSTS_NAMES   => ['40 cards -- $125', '3 cards -- $15'],
    1.26 +        COSTS_CODE    => ['40 cards @125.00', '3 cards @15.00'],
    1.27 +        INITIAL_PRICE => '$125.00',
    1.28 +        DEFAULTS      => ['jbond@mi6.co.uk','123.456.7890','James Bond','MI6','Secret Agent','http://www.jamesbond.com'],
    1.29 +        @_,         # argument pair list goes here
    1.30 +    );
    1.31 +    
    1.32 +    @defaults = @{$args{DEFAULTS}};
    1.33 +    $name = $args{NAME};
    1.34 +    @fields = @{$args{FIELDS}};
    1.35 +    @costs_names = @{$args{COSTS_NAMES}};
    1.36 +    @costs_code  = @{$args{COSTS_CODE}};
    1.37 +    $penny = $args{ADD_PENNY};
    1.38 +    $title = $args{TITLE};
    1.39 +    $initial_price = $args{INITIAL_PRICE};
    1.40 +    
    1.41 +}      
    1.42 +
    1.43 +{#determine the total number of fields and payment options present:
    1.44 + 
    1.45 + 
    1.46 +    
    1.47 +    
    1.48 +    $num_fields = $#fields +1;
    1.49 +    $payment_opts = $#costs_names +1 ;
    1.50 +    
    1.51 +}
    1.52 +    
    1.53 +{#read in the file 
    1.54 +    
    1.55 +  {
    1.56 +    local( $/, *FH ) ;
    1.57 +    open( FH, "<BASE.paylist" ) or die "sudden flaming death\n";
    1.58 +    $base = <FH>;
    1.59 +  }
    1.60 +    
    1.61 +}
    1.62 +
    1.63 +    #The base file has the following options:
    1.64 +    
    1.65 +    #PERL::TITLE              x
    1.66 +	#PERL::OPT0 -- PERL::OPT9 x
    1.67 +    #PERL::PAYMENT            x
    1.68 +    #PERL::INPUT              x
    1.69 +    #PERL::PENNY              x
    1.70 +    #PERL::INITIAL_COST       x
    1.71 +   
    1.72 +    
    1.73 +{#PERL::TITLE   
    1.74 +$base =~ s/PERL::TITLE/$title/g;
    1.75 +}
    1.76 +
    1.77 +{#PERL::OPT0 -- PERL::OPT9
    1.78 +for (0..9)
    1.79 +{
    1.80 +my $index = $_;	
    1.81 +my $field = @fields[$index];
    1.82 +my $find = 'PERL::OPT'.$index;
    1.83 +my $replace = "value = \"$field\"";
    1.84 +
    1.85 +
    1.86 +if (!@fields[$index]){$replace = "";}
    1.87 +
    1.88 +$base =~ s/$find/$replace/;
    1.89 +}
    1.90 +}
    1.91 +
    1.92 +{#PERL::PAYMENT
    1.93 +
    1.94 +
    1.95 +my $start  = 
    1.96 +<<DDDDD;
    1.97 +    
    1.98 +    <input type="radio" name = "whatev"
    1.99 +
   1.100 +	value="PERL::CODE"   PERL::CHECKED
   1.101 +	onclick = "ReadForm (this.form, false);"
   1.102 +	onload = "ReadForm (this.form, false);" >
   1.103 +	PERL::COST
   1.104 +	
   1.105 +	<br>
   1.106 +	
   1.107 +DDDDD
   1.108 +
   1.109 +
   1.110 +$start2 = $start;
   1.111 +
   1.112 +$start =~ s/PERL::COST/@costs_names[0]/;
   1.113 +$start =~ s/PERL::CODE/@costs_code[0]/;
   1.114 +$start =~ s/PERL::CHECKED/\"CHECKED\"/;
   1.115 +
   1.116 +
   1.117 +
   1.118 +if (2 ==  $payment_opts)
   1.119 +{
   1.120 +
   1.121 +$start2 =~ s/PERL::COST/@costs_names[1]/;
   1.122 +$start2 =~ s/PERL::CODE/@costs_code[1]/;
   1.123 +$start2 =~ s/PERL::CHECKED//;
   1.124 +$start = $start.$start2;
   1.125 +
   1.126 +}
   1.127 +
   1.128 +$base =~ s/PERL::PAYMENT/$start/;
   1.129 +
   1.130 +}
   1.131 +
   1.132 +{#PERL::INPUT
   1.133 +
   1.134 +
   1.135 +$start = <<OHYEAH;
   1.136 +<br>
   1.137 +PERL::OPT:&nbsp;&nbsp;
   1.138 +<input type="text" id="PERL::OPT" name="line_PERL::NUMb" size="20" value = "PERL::DEFAULT" ONFOCUS="clearDefault(this)">
   1.139 +<!--   -->
   1.140 +<br>
   1.141 +OHYEAH
   1.142 +
   1.143 +
   1.144 +my $input = "";
   1.145 +
   1.146 +for (0..$#fields)
   1.147 +{
   1.148 +	$rrr = $_+1;
   1.149 +	$t = $start;
   1.150 +	$t =~ s/PERL::NUM/$rrr/;
   1.151 +	$t =~ s/PERL::OPT/$fields[$_]/g;
   1.152 +	$t =~ s/PERL::DEFAULT/$defaults[$_]/;
   1.153 +	$input = $input.$t;
   1.154 +	
   1.155 +}
   1.156 +
   1.157 +$base =~ s/PERL::INPUT/$input/;
   1.158 +
   1.159 +}
   1.160 +
   1.161 +{#PERL::PENNY
   1.162 +my $penny_text;
   1.163 +
   1.164 +if ($penny){
   1.165 +$penny_text = 
   1.166 +<<PPP
   1.167 +<br>
   1.168 +<input type     = "checkbox"       onclick  = "ReadForm (this.form, false);"        value    = "( +0.01 ^__^ )">
   1.169 +Add a penny! ^__^
   1.170 +<br>
   1.171 +PPP
   1.172 +}
   1.173 +
   1.174 +$base =~ s/PERL::PENNY/$penny_text/;
   1.175 +}
   1.176 +
   1.177 +{#PERL::INITIAL_COST
   1.178 +$base =~ s/PERL::INITIAL_COST/\"$initial_price\"/;
   1.179 +}
   1.180 +
   1.181 +
   1.182 +
   1.183 +{#print the revised paylist out
   1.184 +open(OUT,">$name.paylist") or die "DEATH $!";
   1.185 +print OUT $base;
   1.186 +}
   1.187 +
   1.188 +
   1.189 +
   1.190 +} 
   1.191 +
   1.192 +1;#stupidity