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 		DESC   => "Laser-Etched Clear 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 here

    28     );

    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 }      

    41 

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

    43  

    44  

    45     

    46     

    47     $num_fields = $#fields +1;

    48     $payment_opts = $#costs_names +1 ;

    49     

    50 }

    51     

    52 {#read in the file 

    53     

    54   {

    55     local( $/, *FH ) ;

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

    57     $base = <FH>;

    58   }

    59     

    60 }

    61 

    62     #The base file has the following options:

    63     

    64     #PERL::TITLE              x

    65 	#PERL::OPT0 -- PERL::OPT9 x

    66     #PERL::PAYMENT            x

    67     #PERL::INPUT              x

    68     #PERL::PENNY              x

    69     #PERL::INITIAL_COST       x

    70    

    71     

    72 {#PERL::TITLE   

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

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

    75 $base =~ s/PERL::DESC/$desc/g;

    76 }

    77 

    78 {#PERL::OPT0 -- PERL::OPT9

    79 for (0..9)

    80 {

    81 my $index = $_;	

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

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

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

    85 

    86 

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

    88 

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

    90 }

    91 }

    92 

    93 {#PERL::PAYMENT

    94 

    95 

    96 my $start  = 

    97 <<DDDDD;

    98     

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

   100 

   101 	value="PERL::CODE"   PERL::CHECKED

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

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

   104 	PERL::COST

   105 	

   106 	<br>

   107 	

   108 DDDDD

   109 

   110 

   111 $start2 = $start;

   112 

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

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

   115 $start =~ s/PERL::CHECKED/CHECKED/;

   116 

   117 

   118 

   119 if (2 ==  $payment_opts)

   120 {

   121 

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

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

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

   125 $start = $start.$start2;

   126 

   127 }

   128 

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

   130 

   131 }

   132 

   133 {#PERL::INPUT

   134 

   135 

   136 $start = <<OHYEAH;

   137 <br>

   138 PERL::OPT:&nbsp;&nbsp;<br>

   139 <input type="text" MAXLENGTH = 30 name="line_PERL::NUMb" size="20" id="PERL::OPT" 

   140 ONFOCUS="clearDefault(this);" onKeyUp="stabForm('PERL::OPT');smallRedraw('PERL::SHORT', 'PERL::OPT');"

   141 

   142 >

   143 <!--   -->

   144 <br>

   145 OHYEAH

   146 $start =~ s/PERL::SHORT/$short_form/g;

   147 

   148 my $input = "";

   149 

   150 for (0..$#fields)

   151 {

   152 	$rrr = $_+1;

   153 	$t = $start;

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

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

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

   157 	$input = $input.$t;

   158 	

   159 }

   160 

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

   162 

   163 }

   164 

   165 {#PERL::PENNY

   166 my $penny_text;

   167 

   168 if ($penny){

   169 $penny_text = 

   170 <<PPP

   171 <br>

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

   173 Add a penny! ^__^

   174 <br>

   175 PPP

   176 }

   177 

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

   179 }

   180 

   181 {#PERL::INITIAL_COST

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

   183 }

   184 

   185 

   186 

   187 {#print the revised paylist out

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

   189 print OUT $base;

   190 }

   191 

   192 

   193 

   194 } 

   195 

   196 1;#stupidity
author	rlm
date	Sun, 31 Jan 2010 21:37:24 -0500
parents	26c2b3ad21c7
children	8324f195ef36