oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

shipping is closer

Browse source
This commit is contained in:
JT Smith 2008-03-07 17:04:26 +00:00
parent 14ffef86c1
commit a535104d7a
5 changed files with 103 additions and 81 deletions
Download patch file Download diff file Expand all files Collapse all files

10
lib/WebGUI/Content/Shop.pm
View file

@ -128,8 +128,9 @@ sub www_pay {
my $session = shift;
my $output = undef;
my $method = "www_".$session->form->get("method");
if ($method ne "www_" && WebGUI::Shop::Pay->can($method)) {
$output = WebGUI::Shop::Pay->$method($session);
my $pay = WebGUI::Shop::Pay->new($session);
if ($method ne "www_" && $pay->can($method)) {
$output = $pay->$method();
}
return $output;
}
@ -146,8 +147,9 @@ sub www_ship {
my $session = shift;
my $output = undef;
my $method = "www_".$session->form->get("method");
if ($method ne "www_" && WebGUI::Shop::Ship->can($method)) {
$output = WebGUI::Shop::Ship->$method($session);
my $ship = WebGUI::Shop::Ship->new($session);
if ($method ne "www_" && $ship->can($method)) {
$output = $ship->$method($session);
}
return $output;
}

2
lib/WebGUI/Shop/Admin.pm
View file

@ -28,7 +28,7 @@ These subroutines are available from this package:
=cut
public session => my %session;
readonly session => my %session;
#-------------------------------------------------------------------

164
lib/WebGUI/Shop/Ship.pm
View file

@ -2,6 +2,7 @@ package WebGUI::Shop::Ship;
use strict;
use Class::InsideOut qw{ :std };
use WebGUI::Exception;
use WebGUI::International;
use WebGUI::Pluggable;
@ -27,17 +28,16 @@ These subroutines are available from this package:
=cut
readonly session => my %session;
#-------------------------------------------------------------------
=head2 create ( $session, $class, $options )
=head2 addShipper ( $class, $options )
The interface method for creating new, configured instances of ShipDriver. If the ShipperDriver throws an exception, it is propagated
back up to the top.
=head3 $session
A WebGUI::Session object.
=head4 $class
The class of the new ShipDriver object to create.
@ -48,16 +48,14 @@ A list of properties to assign to this ShipperDriver. See C<definition> for det
=cut
sub create {
my $class = shift;
sub addShipper {
my $self = shift;
my $session = shift;
WebGUI::Error::InvalidParam->throw(error => q{Must provide a session variable})
unless ref $session eq 'WebGUI::Session';
my $requestedClass = shift;
WebGUI::Error::InvalidParam->throw(error => q{Must provide a class to create an object})
unless defined $requestedClass;
WebGUI::Error::InvalidParam->throw(error => q{The requested class is not enabled in your WebGUI configuration file}, param => $requestedClass)
unless isIn($requestedClass, @{ WebGUI::Shop::Ship->getDrivers($session) } );
unless isIn($requestedClass, keys %{$self->getDrivers($session) } );
my $options = shift;
WebGUI::Error::InvalidParam->throw(error => q{You must pass a hashref of options to create a new ShipDriver object})
unless defined($options) and ref $options eq 'HASH' and scalar keys %{ $options };
@ -67,23 +65,19 @@ sub create {
#-------------------------------------------------------------------
=head2 getDrivers ( $session )
=head2 getDrivers ( )
This subroutine returns an arrayref of available shipping driver classes
from the WebGUI config file.
=head3 $session
A WebGUI::Session object. A WebGUI::Error::InvalidParam exception will be thrown if it doesn't get one.
This subroutine returns a hash reference of available shipping driver classes as keys with their human readable names as values, read from the WebGUI config file in the shippingDrivers directive.
=cut
sub getDrivers {
my $class = shift;
my $session = shift;
WebGUI::Error::InvalidParam->throw(error => q{Must provide a session variable})
unless ref $session eq 'WebGUI::Session';
return $session->config->get('shippingDrivers');
my $self = shift;
my %drivers = ();
foreach my $class (@{$self->session->config->get('shippingDrivers')}) {
$drivers{$class} = eval { WebGUI::Pluggable::instanciate($class, 'getName', [ $self->session ])};
}
return \%drivers;
}
#-------------------------------------------------------------------
@ -102,11 +96,11 @@ A WebGUI::Shop::Cart object. A WebGUI::Error::InvalidParam exception will be th
=cut
sub getOptions {
my ($class, $cart) = @_;
my ($self, $cart) = @_;
WebGUI::Error::InvalidParam->throw(error => q{Need a cart.}) unless defined $cart and $cart->isa("WebGUI::Shop::Cart");
my $session = $cart->session;
my %options = ();
foreach my $shipper (@{$class->getShippers($session)}) {
foreach my $shipper (@{$self->getShippers()}) {
$options{$shipper->getId} = {
label => $shipper->get("label"),
price => $shipper->calculate($cart),
@ -117,57 +111,21 @@ sub getOptions {
#-------------------------------------------------------------------
=head2 getShippers ( $session )
Returns an array ref of all shipping objects in the db.
=head3 $session
A WebGUI::Session object. A WebGUI::Error::InvalidParam exception will be thrown if it doesn't get one.
=head3
=cut
sub getShippers {
my $class = shift;
my $session = shift;
WebGUI::Error::InvalidParam->throw(error => q{Must provide a session variable})
unless ref $session eq 'WebGUI::Session';
my @drivers = ();
my $sth = $session->db->prepare('select shipperId from shipper');
$sth->execute();
while (my $driver = $sth->hashRef()) {
push @drivers, WebGUI::Shop::Ship->new($session, $driver->{shipperId});
}
$sth->finish;
return \@drivers;
}
#-------------------------------------------------------------------
=head2 new ( $session, $shipperId )
=head2 getShipper ( )
Looks up an existing ShipperDriver in the db by shipperId and returns
that object. If the ShipperDriver throws an exception, it is propagated
back up to the top.
=head3 $session
=head3 id
A WebGUI::Session object.
=head3 $shipperId
The ID of a shipper to look up and instanciate.
The id of the shipper to instanciate.
=cut
sub new {
my $class = shift;
my $session = shift;
WebGUI::Error::InvalidParam->throw(error => q{Must provide a session variable})
unless ref $session eq 'WebGUI::Session';
my $shipperId = shift;
sub getShipper {
my ($self, $shipperId) = @_;
my $session = $self->session;
WebGUI::Error::InvalidParam->throw(error => q{Must provide a shipperId})
unless defined $shipperId;
my $requestedClass = $session->db->quickScalar('select className from shipper where shipperId=?',[$shipperId]);
@ -179,6 +137,58 @@ sub new {
#-------------------------------------------------------------------
=head2 getShippers ( )
Returns an array ref of all shipping objects in the db.
=head3
=cut
sub getShippers {
my $self = shift;
my @drivers = ();
my $sth = $self->session->db->prepare('select shipperId from shipper');
$sth->execute();
while (my $driver = $sth->hashRef()) {
push @drivers, $self->getShipper($driver->{shipperId});
}
$sth->finish;
return \@drivers;
}
#-------------------------------------------------------------------
=head2 new ( $session )
Constructor.
=head3 $session
A WebGUI::Session object.
=cut
sub new {
my $class = shift;
my $session = shift;
WebGUI::Error::InvalidObject->throw(expected=>"WebGUI::Session", got=>(ref $session), error => q{Must provide a session variable}) unless ref $session eq 'WebGUI::Session';
my $self = register $class;
my $id = id $self;
$session{ $id } = $session;
return $self;
}
#-------------------------------------------------------------------
=head2 session ()
Returns a reference to the current session.
=cut
#-------------------------------------------------------------------
=head2 www_do ( )
Let's ship drivers do method calls. Requires a driver param in the post form vars which contains the id of the driver to load.
@ -186,9 +196,10 @@ Let's ship drivers do method calls. Requires a driver param in the post form var
=cut
sub www_do {
my ($class, $session) = @_;
my $form = $session->form;
my $driver = $class->new($session, $form->get("driver"));
my ($self) = @_;
my $form = $self->session->form;
WebGUI::Error::InvalidParam->throw(error => q{must have a form var called driver with a driver id }) if ($form->get("driver") eq "");
my $driver = $self->getShipper($form->get("driver"));
my $output = undef;
my $method = "www_". ( $form->get("do"));
if ($driver->can($method)) {
@ -206,12 +217,21 @@ The main management screen for shippers.
=cut
sub www_manage {
my ($class, $session) = @_;
my ($self) = @_;
my $session = $self->session;
return $session->privilege->adminOnly() unless ($session->user->isInGroup("3"));
my $admin = WebGUI::Shop::Admin->new($session);
my $console = $admin->getAdminConsole;
my $output = "Test";
my $i18n = WebGUI::International->new($session, "Shop");
my $output = WebGUI::Form::formHeader($session)
.WebGUI::Form::hidden($session, {name=>"shop", value=>"ship"})
.WebGUI::Form::hidden($session, {name=>"method", value=>"addDriver"})
.WebGUI::Form::selectBox($session, {name=>"className", options=>$self->getDrivers})
.WebGUI::Form::submit($session, {value=>$i18n->get("add shipper")})
.WebGUI::Form::formFooter($session);
foreach my $shipper (@{$self->getShippers}) {
}
my $console = $admin->getAdminConsole;
return $console->render($output, $i18n->get("shipping methods"));
}

6
lib/WebGUI/Shop/ShipDriver.pm
View file

@ -240,7 +240,7 @@ sub getId {
#-------------------------------------------------------------------
=head2 getName ( )
=head2 getName ( $session )
Return a human readable name for this driver. Never overridden in the
subclass, instead specified in definition with the name "name".
@ -248,8 +248,8 @@ subclass, instead specified in definition with the name "name".
=cut
sub getName {
my $self = shift;
my $definition = $self->definition($self->session);
my ($class, $session) = @_;
my $definition = $class->definition($session);
return $definition->[0]->{name};
}

2
lib/WebGUI/Shop/Tax.pm
View file

@ -152,7 +152,7 @@ this is not used, it uses the current session user object.
sub canEdit {
my $self = shift;
my $user = shift || $session->user;
my $user = shift || $self->session->user;
return $user->isInGroup( $self->session->get('groupIdAdminCommerce'));
}