Jeff 'japhy' Pinyan wrote:
On Aug 15, Scott R. Godin said:
Jeff 'japhy' Pinyan wrote:
Oh, Jolly Good! though I'm somewhat concerned with how much memory
that would take up. Ultimately this would be running as a cgi
processing a web-form submission.
Unless you're dealing with thousands of elements in your array, I
wouldn't expect a noticeable effect.
Then you would simply poll @discount to find out the rate; this is
assuming $quantity is some positive number:
my $rate = ($discount[$quantity] || $discount[-1]) / 100;
almost. when $discount[1] = 0 that makes it assume the 55% discount
instead. see below.
Oh, right, my bad.
Ultimately it worked out to the below. I'd be interested in seeing any further
suggestions you all may have.
use Carp qw{carp croak};
{# closure to retain value tables for subs in this section
my (@discount, %price, @shiprate);
while ( <DATA> )
{
chomp;
if ( /^quantity/)
{
my($lower, $upper, $disc);
if ( ($lower, $upper, $disc) = /(\d+)\s+-\s+(\d+)\s+(\d+)%\s*$/ )
{
@discount[$lower..$upper] = ($disc) x ($upper - $lower + 1);
}
elsif ( ($lower, $disc) = /(\d+)\+\s+(\d+)%\s*$/ )
{
$discount[$lower] = $disc;
}
else
{
die "unsupported discount line (#$.): '$_'";
}
next;
}
if ( /^price/ )
{
if (my($book, $retail) = /(\w+)\s+\$([\d.]+)\s*$/)
{
$price{$book} = $retail;
}
else
{
die "unsupported price line (#$.): '$_'";
}
next;
}
if ( /^shipping/ )
{
if ( my($lower, $upper, $rate) = /(\d+)\s+-\s+(\d+)\s+\$(\d+)\s*$/ )
{
@shiprate[$lower .. $upper] = ($rate) x ($upper - $lower + 1);
}
else
{
die "unsupported shipping line (#$.): '$_'";
}
next;
}
warn "nonmatching line in DATA table (#$.): '$_'";
}
sub _discount (@)
{
my(@quantities, $qty) = @_;
$qty += $fields{$_}[0] for @quantities;
return 0 unless defined($qty) and $qty =~ /^\d+$/ and $qty > 0;
return ((defined($discount[$qty]) ? $discount[$qty] : $discount[-1]) / 100);
}
sub _price ($)
{
my $book = shift;
croak "Unknown book $book" unless exists $price{$book};
return $price{$book};
}
sub _shipping
{
my( @books ) = keys %price;
my $total_quantity = 0;
foreach my $book ( @books )
{
croak "Unknown Book $book " unless exists $price{$book};
if ( $fields{"${book}_quantity"}[0] =~ /^\d+$/)
{
$total_quantity += $fields{"${book}_quantity"}[0];
}
else
{
croak("Invalid Quantity for '$book' : '",
$fields{"${book}_quantity"}[0]. "'" );
}
}
#quantity less than or equal to highest quantity we ship in one box
if ($total_quantity <= $#shiprate )
{
return ( $shiprate[$total_quantity] );
}
my $total_shipping =
($shiprate[-1] * int($total_quantity / $#shiprate))
+ $shiprate[ $total_quantity % $#shiprate ];
return $total_shipping;
}
my %unit;
sub _unit ($)
{
my $book = shift;
croak "Unknown book $book" unless exists $price{$book};
return $unit{$book} if $unit{$book};
my $price = _price($book)
or croak "Warning: DATA contains No Price for $book";
my $rate = _discount( grep{ /_quantity$/ } keys %fields );
$unit{$book} = sprintf( "%.2f", $price - sprintf( "%.2f", $price * $rate ));
$unit{"$book total"} =
sprintf( "%.2f", $fields{"${book}_quantity"}[0] * $unit{$book});
$unit{subtotal} += $unit{"$book total"};
return $unit{$book};
}
sub _unit_total ($)
{
my $book = shift;
croak "Unknown book $book" unless exists $price{$book};
return $unit{"$book total"} if $unit{"$book total"};
_unit($book) && return $unit{"$book total"};
}
sub _subtotal
{
croak "Subtotal called too early" unless defined $unit{subtotal};
return ( sprintf("%.2f", $unit{subtotal}) );
}
}
__DATA__
quantity 0 - 9 0%
quantity 10 - 19 25%
quantity 20 - 199 40%
quantity 200 - 499 50%
quantity 500+ 55%
price rkh $15.95
price rkp $6.95
price rmh $15.95
price rmp $6.95
price rbh $15.95
price rbp $6.95
shipping 0 - 0 $0
shipping 1 - 2 $4
shipping 3 - 6 $6
shipping 7 - 10 $8
shipping 11 - 20 $10
shipping 21 - 30 $12
shipping 31 - 40 $16
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
