view release on metacpan or  search on metacpan

lib/Apache/iNcom/CartManager.pm  view on Meta::CPAN

#
#    CartManager.pm - Object that manages user shopping cart
#
#    This file is part of Apache::iNcom.
#
#    Author: Francis J. Lacoste <francis.lacoste@iNsu.COM>
#
#    Copyright (C) 1999 Francis J. Lacoste, iNsu Innovations
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
package Apache::iNcom::CartManager;

use strict;


use vars qw( $VERSION );

BEGIN {
    ($VERSION) = '$Revision: 1.7 $' =~ /Revision: ([\d.]+)/;
}

=pod

=head1 NAME

Apache::iNcom::CartManager - Object responsible for managing the user
shopping cart. 

=head1 SYNOPSIS

    $Cart->order( \%item );
    my $items = $Cart->items;
    $Cart->empty;

=head1 DESCRIPTION

This is the part of the Apache::iNcom framework that is responsible for
managing the user shopping cart. It keep tracks of the ordered items and
is also responsible for the pricing of the order. It this is module that
computes taxes, discount, price, shipping, etc.

=head1 DESIGN RATIONALE

Well not completly since all these operations are delegated to user
implemented functions implemented in a pricing profile. The idea
behind it is to make policy external to the framework. One thing that
varies considerably between different applications is the pricing,
discount, taxes, etc. So this is left to the implementation of the
application programmer.

=head1 PRICING PROFILE

The pricing profile is a file which is C{eval}-ed at runtime. (It is also
reloaded whenever it changes on disk. It should return an hash reference
which may contains the following key :

=over

=item item_price

The function should return the price of the item. The function is passed
only one parameter : the item which we should compute the price.

    Ex:	item_price => sub {
	my $item = shift;
	my $data = $DB->template_get( "product", $item->{code} );
	return $data->{price};
    }

=item item_discount

The function should return the discounts that apply for that
particular item. It can return zero or more discounts. It returning
more that one discount return a an array reference. Discount are
substracted from the item price so don't return a percentage.

    Ex:	item_discount => sub {
	my $item = shift;

	# Discount are relative to item and quantity
	my $data = $DB->template_get( "discount", $item->{code},
				      $item->{quantity} );
	return unless $data; # No discount

	# Discount is proportional to the price
	return $item->{price} * $data->{discount};
    }

The subtotal of the cart is equal to the sum of

	($item->{price} - $item->{discount}) * $item->{quantity}

=item shipping

This function determines the shipping charges that will be added to
the subtotal. The function receives as arguments the subtotal of the
cart and an array ref to the cart's items. It should return zero or
more shipping charges that will be added to the subtotal. If returning
more that one charges, return an array reference.

    Ex: shipping => sub {
	    # Flat fee based shipping charges
	    if ( $Session{shipping} eq "ONE_NIGHT" ) {
		return 45;
	    } else {
		return 15;
	    }
	}

=item discount

That function determines discount that will be substracted from the
subtotal. Function is called with 3 arguments, the subtotal of the
cart, the shipping charges and an array reference to the cart's items.
Again the function may elect to return zero or more discounts and should
return an array reference if returning more that one discounts.

    Ex: discount => sub {
	my $subtotal = shift;
	my $user = $Request->user;
	return unless $user->{discount};

	return $subtotal * $user->{discount};
    }

=item taxes

That functions determines the taxes charges that will be added to the
order. It should return zero or more taxes. If the functions returns
more that one taxes, it should return an array reference. The
functions receives 4 arguments, the cart's subtotal, the shipping
charges, the discount and the cart's items as an array reference.

    Ex: taxes => sub {
	my ( $sub, $ship, $disc ) = @_;

	# We only charges taxes to Quebec's resident. All our
	# items are taxable and is shipping.
	if ( ${$Request->user}->{province} eq "QC" ) {
	    my $taxable = $sub + $ship - $disc;
	    my $gst = $taxable * 0.07
	    my $gsp = ($taxable + $gst) * 0.075

	    return [ $gst, $gsp ];
	} else {
	    return undef;
	}
    }

=back

If one of these functions is left undefined. The framework will create
one on the fly which will return 0. (No taxes, no discount, no
shipping charges, item is free, etc).

All those functions are defined and execute in the namespace of the
pages which will use the $Cart object. This means that those functions
have access to the standard Apache::iNcom globals ($Request, %Session, 
$Localizer, $Locale, etc ). DONT ABUSE IT. Also, don't call any methods
on the $Cart object or you'll die of infinite recursion.

=head1 WHAT IS AN ITEM

An item is simply an hash with some reserved key names. All other keys
are ignored by the CartManager. Each item with the same (non reserved)
key values is assumed to be identic in terms of price, discount, etc.

This design was chosen to handle the infinite variety of item
attributes (color, size, variant, ...). The framework doesn't need
knowledge of those, only the application specific part. (The pricing
functions.)

These are reserved names and can't be used as item attributes :
C<quantity>, C<price>, C<discount>, C<subtotal>

=head1 INITIALIZATION

An object is automatically initialized on each request by the
Apache::iNcom framework. It is accessible through the $Cart global
variable in Apache::iNcom pages.

=cut

sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;

    my ( $cart, $package, $profile_file ) = @_;

    $cart ||= {};

    bless { profile_file => $profile_file,
	    cart	 => $cart,
	    package	 => $package,
	  }, $class;
}

sub cart {
    my $self = shift;

    # Return the cart data structure.
    $self->{cart};
}

my %DEFAULT_DELEGATES = (
			 item_price	=> sub { 0 },
			 item_discount	=> sub { 0 },
			 discount	=> sub { 0 },
			 shipping	=> sub { 0 },
			 taxes		=> sub { 0 },
			);

sub load_delegates {
    my $self = shift;

    # Define delegates in the namespace of the page
    my $delegates_code = "package " . $self->{package} . ";\n";

    # Read in the delegates code
    open ( DELEGATES, $self->{profile_file} )
      or die "Error loading pricing delegates: $!\n";
    my $line;
    while ( defined ( $line = <DELEGATES> ) ) {
	$delegates_code .= $line;
    }
    close DELEGATES;

    my $delegates = eval $delegates_code;
    die "Error evaluating delegates: $@" if $@;
    die "Delegates didn't evaluate to an hash ref\n"
      unless ref $delegates eq "HASH";

    # Make sure that defaults functions are defined for
    # all of them
    for my $name (keys %DEFAULT_DELEGATES ) {
	my $f = $delegates->{$name} ||= $DEFAULT_DELEGATES{$name};
	die "Delegate $name is not a function ref\n" 
	  unless ref $f eq "CODE";
    }