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@57: DESC => "Clear, Scratch Resistant,
Laser-Etched Acrylic.", 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@42: DEFAULTS => ['PERL::EMAIL','PERL','James Bond','MI6','Secret Agent','http://www.jamesbond.com'], rlm@4: @_, # argument pair list goes here rlm@4: ); rlm@40: $short_form = $args{SHORT_FORM}; 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@32: $desc = $args{DESC}; 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, "; 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@32: $base =~ s/PERL::DESC/$desc/g; 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@57: my $init = rlm@4: < rlm@4: PERL::COST rlm@4: rlm@4:
rlm@4: rlm@4: DDDDD rlm@4: rlm@4: rlm@4: rlm@57: $start = ""; rlm@57: for (0..$payment_opts-1) rlm@4: rlm@57: { rlm@57: $temp = $init; rlm@4: rlm@4: rlm@57: $temp =~ s/PERL::COST/@costs_names[$_]/; rlm@57: $temp =~ s/PERL::CODE/@costs_code[$_]/; rlm@57: $temp =~ s/PERL::CHECKED/CHECKED/; rlm@57: $start = $start.$temp; rlm@4: } rlm@4: rlm@4: $base =~ s/PERL::PAYMENT/$start/; rlm@57: $start = $temp = $init =""; rlm@4: } rlm@4: rlm@4: {#PERL::INPUT rlm@4: rlm@4: rlm@4: $start = < rlm@46: PERL::OPT:  
rlm@49: rlm@4: rlm@4:
rlm@4: OHYEAH rlm@42: $start =~ s/PERL::SHORT/$short_form/g; 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: < rlm@4: rlm@4: Add a penny! ^__^ rlm@4:
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