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      => ['jbond@mi6.co.uk','123.456.7890','James Bond','MI6','Secret Agent','http://www.jamesbond.com'],

    27         @_,         # argument pair list goes here

    28     );

    29     $prod_name = $args{PRODUCT_NAME};

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

    31     $name = $args{NAME};

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

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

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

    35     $penny = $args{ADD_PENNY};

    36     $title = $args{TITLE};

    37     $initial_price = $args{INITIAL_PRICE};

    38 	$desc = $args{DESC};

    39 }      

    40 

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

    42  

    43  

    44     

    45     

    46     $num_fields = $#fields +1;

    47     $payment_opts = $#costs_names +1 ;

    48     

    49 }

    50     

    51 {#read in the file 

    52     

    53   {

    54     local( $/, *FH ) ;

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

    56     $base = <FH>;

    57   }

    58     

    59 }

    60 

    61     #The base file has the following options:

    62     

    63     #PERL::TITLE              x

    64 	#PERL::OPT0 -- PERL::OPT9 x

    65     #PERL::PAYMENT            x

    66     #PERL::INPUT              x

    67     #PERL::PENNY              x

    68     #PERL::INITIAL_COST       x

    69    

    70     

    71 {#PERL::TITLE   

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

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

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

    75 }

    76 

    77 {#PERL::OPT0 -- PERL::OPT9

    78 for (0..9)

    79 {

    80 my $index = $_;	

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

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

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

    84 

    85 

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

    87 

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

    89 }

    90 }

    91 

    92 {#PERL::PAYMENT

    93 

    94 

    95 my $start  = 

    96 <<DDDDD;

    97     

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

    99 

   100 	value="PERL::CODE"   PERL::CHECKED

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

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

   103 	PERL::COST

   104 	

   105 	<br>

   106 	

   107 DDDDD

   108 

   109 

   110 $start2 = $start;

   111 

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

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

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

   115 

   116 

   117 

   118 if (2 ==  $payment_opts)

   119 {

   120 

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

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

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

   124 $start = $start.$start2;

   125 

   126 }

   127 

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

   129 

   130 }

   131 

   132 {#PERL::INPUT

   133 

   134 

   135 $start = <<OHYEAH;

   136 <br>

   137 PERL::OPT:&nbsp;&nbsp;

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

   139 onKeyUp="

   140 tt.remove();

   141 

   142 var font_size = 30;

   143 

   144 tt = raphe.print(0, 145, value, raphe.getFont('HelveticaNeue', 700), font_size);

   145 tt.attr('stroke', '#f00');

   146 tt.attr('fill', 'TRANSPARENT');

   147 var c = tt.getBBox().width;

   148 tt.translate((502 - c)/2,0);

   149 

   150 

   151 

   152 

   153 

   154 

   155 //document.write( c );

   156 

   157 

   158 

   159 

   160 

   161 "

   162 

   163 >

   164 <!--   -->

   165 <br>

   166 OHYEAH

   167 

   168 

   169 my $input = "";

   170 

   171 for (0..$#fields)

   172 {

   173 	$rrr = $_+1;

   174 	$t = $start;

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

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

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

   178 	$input = $input.$t;

   179 	

   180 }

   181 

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

   183 

   184 }

   185 

   186 {#PERL::PENNY

   187 my $penny_text;

   188 

   189 if ($penny){

   190 $penny_text = 

   191 <<PPP

   192 <br>

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

   194 Add a penny! ^__^

   195 <br>

   196 PPP

   197 }

   198 

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

   200 }

   201 

   202 {#PERL::INITIAL_COST

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

   204 }

   205 

   206 

   207 

   208 {#print the revised paylist out

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

   210 print OUT $base;

   211 }

   212 

   213 

   214 

   215 } 

   216 

   217 1;#stupidity
author	rlm
date	Sun, 24 Jan 2010 09:37:47 -0500
parents	0deeb2d5d1db
children	1ac1409ea68c