Mercurial > laserkard

     1 

     2 package generate_paylists;

     3 

     4 

     5 use Exporter;

     6 

     7 our @ISA= qw( Exporter );

     8 our @EXPORT = qw( paylist );

     9 

    10 

    11 

    12 

    13 sub paylist 

    14 {

    15 	

    16 {#input stuff

    17     my %args = (

    18 		TITLE  => "Clarity LaserKard --- Classic Style",

    19         NAME   => 'classic_acrylic_clear', 

    20         FIELDS      => ["Line 1", "Line 2","Line 3","Line 4","Line 5","Side"],

    21         ADD_PENNY       => 1, 

    22         COSTS_NAMES   => ['40 cards -- $125', '3 cards -- $15'],

    23         COSTS_CODE    => ['40 cards @125.00', '3 cards @15.00'],

    24         INITIAL_PRICE => '$125.00',

    25         DEFAULTS      => ['jbond@mi6.co.uk','123.456.7890','James Bond','MI6','Secret Agent','http://www.jamesbond.com'],

    26         @_,         # argument pair list goes here

    27     );

    28     $prod_name = $args{PRODUCT_NAME};

    29     @defaults = @{$args{DEFAULTS}};

    30     $name = $args{NAME};

    31     @fields = @{$args{FIELDS}};

    32     @costs_names = @{$args{COSTS_NAMES}};

    33     @costs_code  = @{$args{COSTS_CODE}};

    34     $penny = $args{ADD_PENNY};

    35     $title = $args{TITLE};

    36     $initial_price = $args{INITIAL_PRICE};

    37     

    38 }      

    39 

    40 {#determine the total number of fields and payment options present:

    41  

    42  

    43     

    44     

    45     $num_fields = $#fields +1;

    46     $payment_opts = $#costs_names +1 ;

    47     

    48 }

    49     

    50 {#read in the file 

    51     

    52   {

    53     local( $/, *FH ) ;

    54     open( FH, "<BASE.paylist" ) or die "sudden flaming death\n";

    55     $base = <FH>;

    56   }

    57     

    58 }

    59 

    60     #The base file has the following options:

    61     

    62     #PERL::TITLE              x

    63 	#PERL::OPT0 -- PERL::OPT9 x

    64     #PERL::PAYMENT            x

    65     #PERL::INPUT              x

    66     #PERL::PENNY              x

    67     #PERL::INITIAL_COST       x

    68    

    69     

    70 {#PERL::TITLE   

    71 $base =~ s/PERL::TITLE/$title/g;

    72 $base =~ s/PERL::PRODUCT-NAME/$prod_name/g;

    73 

    74 }

    75 

    76 {#PERL::OPT0 -- PERL::OPT9

    77 for (0..9)

    78 {

    79 my $index = $_;	

    80 my $field = @fields[$index];

    81 my $find = 'PERL::OPT'.$index;

    82 my $replace = "value = \"$field\"";

    83 

    84 

    85 if (!@fields[$index]){$replace = "";}

    86 

    87 $base =~ s/$find/$replace/;

    88 }

    89 }

    90 

    91 {#PERL::PAYMENT

    92 

    93 

    94 my $start  = 

    95 <<DDDDD;

    96     

    97     <input type="radio" name = "whatev"

    98 

    99 	value="PERL::CODE"   PERL::CHECKED

   100 	onclick = "ReadForm (this.form, false);"

   101 	onload = "ReadForm (this.form, false);" >

   102 	PERL::COST

   103 	

   104 	<br>

   105 	

   106 DDDDD

   107 

   108 

   109 $start2 = $start;

   110 

   111 $start =~ s/PERL::COST/@costs_names[0]/;

   112 $start =~ s/PERL::CODE/@costs_code[0]/;

   113 $start =~ s/PERL::CHECKED/\"CHECKED\"/;

   114 

   115 

   116 

   117 if (2 ==  $payment_opts)

   118 {

   119 

   120 $start2 =~ s/PERL::COST/@costs_names[1]/;

   121 $start2 =~ s/PERL::CODE/@costs_code[1]/;

   122 $start2 =~ s/PERL::CHECKED//;

   123 $start = $start.$start2;

   124 

   125 }

   126 

   127 $base =~ s/PERL::PAYMENT/$start/;

   128 

   129 }

   130 

   131 {#PERL::INPUT

   132 

   133 

   134 $start = <<OHYEAH;

   135 <br>

   136 PERL::OPT:&nbsp;&nbsp;

   137 <input type="text" id="PERL::OPT" name="line_PERL::NUMb" size="20" value = "PERL::DEFAULT" ONFOCUS="clearDefault(this)">

   138 <!--   -->

   139 <br>

   140 OHYEAH

   141 

   142 

   143 my $input = "";

   144 

   145 for (0..$#fields)

   146 {

   147 	$rrr = $_+1;

   148 	$t = $start;

   149 	$t =~ s/PERL::NUM/$rrr/;

   150 	$t =~ s/PERL::OPT/$fields[$_]/g;

   151 	$t =~ s/PERL::DEFAULT/$defaults[$_]/;

   152 	$input = $input.$t;

   153 	

   154 }

   155 

   156 $base =~ s/PERL::INPUT/$input/;

   157 

   158 }

   159 

   160 {#PERL::PENNY

   161 my $penny_text;

   162 

   163 if ($penny){

   164 $penny_text = 

   165 <<PPP

   166 <br>

   167 <input type     = "checkbox"       onclick  = "ReadForm (this.form, false);"        value    = "( +0.01 ^__^ )">

   168 Add a penny! ^__^

   169 <br>

   170 PPP

   171 }

   172 

   173 $base =~ s/PERL::PENNY/$penny_text/;

   174 }

   175 

   176 {#PERL::INITIAL_COST

   177 $base =~ s/PERL::INITIAL_COST/\"$initial_price\"/;

   178 }

   179 

   180 

   181 

   182 {#print the revised paylist out

   183 open(OUT,">$name.paylist") or die "DEATH $!";

   184 print OUT $base;

   185 }

   186 

   187 

   188 

   189 } 

   190 

   191 1;#stupidity
author	rlm
date	Sun, 03 Jan 2010 22:26:26 -0500
parents	2979a76e3fdf
children	4475e9ee3c36