rlm@4: 
rlm@4: package generate_paylists;
rlm@4: 
rlm@4: 
rlm@4: use Exporter;
rlm@4: 
rlm@4: our @ISA= qw( Exporter );
rlm@4: our @EXPORT = qw( paylist );
rlm@4: 
rlm@4: 
rlm@4: 
rlm@4: 
rlm@4: sub paylist 
rlm@4: {
rlm@4: 	
rlm@4: {#input stuff
rlm@4:     my %args = (
rlm@4: 		TITLE  => "Clarity LaserKard --- Classic Style",
rlm@4:         NAME   => 'classic_acrylic_clear', 
rlm@4:         FIELDS      => ["Line 1", "Line 2","Line 3","Line 4","Line 5","Side"],
rlm@4:         ADD_PENNY       => 1, 
rlm@4:         COSTS_NAMES   => ['40 cards -- $125', '3 cards -- $15'],
rlm@4:         COSTS_CODE    => ['40 cards @125.00', '3 cards @15.00'],
rlm@4:         INITIAL_PRICE => '$125.00',
rlm@4:         DEFAULTS      => ['jbond@mi6.co.uk','123.456.7890','James Bond','MI6','Secret Agent','http://www.jamesbond.com'],
rlm@4:         @_,         # argument pair list goes here
rlm@4:     );
rlm@24:     $prod_name = $args{PRODUCT_NAME};
rlm@4:     @defaults = @{$args{DEFAULTS}};
rlm@4:     $name = $args{NAME};
rlm@4:     @fields = @{$args{FIELDS}};
rlm@4:     @costs_names = @{$args{COSTS_NAMES}};
rlm@4:     @costs_code  = @{$args{COSTS_CODE}};
rlm@4:     $penny = $args{ADD_PENNY};
rlm@4:     $title = $args{TITLE};
rlm@4:     $initial_price = $args{INITIAL_PRICE};
rlm@4:     
rlm@4: }      
rlm@4: 
rlm@4: {#determine the total number of fields and payment options present:
rlm@4:  
rlm@4:  
rlm@4:     
rlm@4:     
rlm@4:     $num_fields = $#fields +1;
rlm@4:     $payment_opts = $#costs_names +1 ;
rlm@4:     
rlm@4: }
rlm@4:     
rlm@4: {#read in the file 
rlm@4:     
rlm@4:   {
rlm@4:     local( $/, *FH ) ;
rlm@4:     open( FH, "<BASE.paylist" ) or die "sudden flaming death\n";
rlm@4:     $base = <FH>;
rlm@4:   }
rlm@4:     
rlm@4: }
rlm@4: 
rlm@4:     #The base file has the following options:
rlm@4:     
rlm@4:     #PERL::TITLE              x
rlm@4: 	#PERL::OPT0 -- PERL::OPT9 x
rlm@4:     #PERL::PAYMENT            x
rlm@4:     #PERL::INPUT              x
rlm@4:     #PERL::PENNY              x
rlm@4:     #PERL::INITIAL_COST       x
rlm@4:    
rlm@4:     
rlm@4: {#PERL::TITLE   
rlm@4: $base =~ s/PERL::TITLE/$title/g;
rlm@24: $base =~ s/PERL::PRODUCT-NAME/$prod_name/g;
rlm@24: 
rlm@4: }
rlm@4: 
rlm@4: {#PERL::OPT0 -- PERL::OPT9
rlm@4: for (0..9)
rlm@4: {
rlm@4: my $index = $_;	
rlm@4: my $field = @fields[$index];
rlm@4: my $find = 'PERL::OPT'.$index;
rlm@4: my $replace = "value = \"$field\"";
rlm@4: 
rlm@4: 
rlm@4: if (!@fields[$index]){$replace = "";}
rlm@4: 
rlm@4: $base =~ s/$find/$replace/;
rlm@4: }
rlm@4: }
rlm@4: 
rlm@4: {#PERL::PAYMENT
rlm@4: 
rlm@4: 
rlm@4: my $start  = 
rlm@4: <<DDDDD;
rlm@4:     
rlm@4:     <input type="radio" name = "whatev"
rlm@4: 
rlm@4: 	value="PERL::CODE"   PERL::CHECKED
rlm@4: 	onclick = "ReadForm (this.form, false);"
rlm@4: 	onload = "ReadForm (this.form, false);" >
rlm@4: 	PERL::COST
rlm@4: 	
rlm@4: 	<br>
rlm@4: 	
rlm@4: DDDDD
rlm@4: 
rlm@4: 
rlm@4: $start2 = $start;
rlm@4: 
rlm@4: $start =~ s/PERL::COST/@costs_names[0]/;
rlm@4: $start =~ s/PERL::CODE/@costs_code[0]/;
rlm@4: $start =~ s/PERL::CHECKED/\"CHECKED\"/;
rlm@4: 
rlm@4: 
rlm@4: 
rlm@4: if (2 ==  $payment_opts)
rlm@4: {
rlm@4: 
rlm@4: $start2 =~ s/PERL::COST/@costs_names[1]/;
rlm@4: $start2 =~ s/PERL::CODE/@costs_code[1]/;
rlm@4: $start2 =~ s/PERL::CHECKED//;
rlm@4: $start = $start.$start2;
rlm@4: 
rlm@4: }
rlm@4: 
rlm@4: $base =~ s/PERL::PAYMENT/$start/;
rlm@4: 
rlm@4: }
rlm@4: 
rlm@4: {#PERL::INPUT
rlm@4: 
rlm@4: 
rlm@4: $start = <<OHYEAH;
rlm@4: <br>
rlm@4: PERL::OPT:&nbsp;&nbsp;
rlm@4: <input type="text" id="PERL::OPT" name="line_PERL::NUMb" size="20" value = "PERL::DEFAULT" ONFOCUS="clearDefault(this)">
rlm@4: <!--   -->
rlm@4: <br>
rlm@4: OHYEAH
rlm@4: 
rlm@4: 
rlm@4: my $input = "";
rlm@4: 
rlm@4: for (0..$#fields)
rlm@4: {
rlm@4: 	$rrr = $_+1;
rlm@4: 	$t = $start;
rlm@4: 	$t =~ s/PERL::NUM/$rrr/;
rlm@4: 	$t =~ s/PERL::OPT/$fields[$_]/g;
rlm@4: 	$t =~ s/PERL::DEFAULT/$defaults[$_]/;
rlm@4: 	$input = $input.$t;
rlm@4: 	
rlm@4: }
rlm@4: 
rlm@4: $base =~ s/PERL::INPUT/$input/;
rlm@4: 
rlm@4: }
rlm@4: 
rlm@4: {#PERL::PENNY
rlm@4: my $penny_text;
rlm@4: 
rlm@4: if ($penny){
rlm@4: $penny_text = 
rlm@4: <<PPP
rlm@4: <br>
rlm@4: <input type     = "checkbox"       onclick  = "ReadForm (this.form, false);"        value    = "( +0.01 ^__^ )">
rlm@4: Add a penny! ^__^
rlm@4: <br>
rlm@4: PPP
rlm@4: }
rlm@4: 
rlm@4: $base =~ s/PERL::PENNY/$penny_text/;
rlm@4: }
rlm@4: 
rlm@4: {#PERL::INITIAL_COST
rlm@4: $base =~ s/PERL::INITIAL_COST/\"$initial_price\"/;
rlm@4: }
rlm@4: 
rlm@4: 
rlm@4: 
rlm@4: {#print the revised paylist out
rlm@4: open(OUT,">$name.paylist") or die "DEATH $!";
rlm@4: print OUT $base;
rlm@4: }
rlm@4: 
rlm@4: 
rlm@4: 
rlm@4: } 
rlm@4: 
rlm@4: 1;#stupidity