From a535104d7a5069bf3f9bb46d9ac51e7dedf075b2 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Fri, 7 Mar 2008 17:04:26 +0000 Subject: [PATCH] shipping is closer --- lib/WebGUI/Content/Shop.pm | 10 ++- lib/WebGUI/Shop/Admin.pm | 2 +- lib/WebGUI/Shop/Ship.pm | 164 +++++++++++++++++++--------------- lib/WebGUI/Shop/ShipDriver.pm | 6 +- lib/WebGUI/Shop/Tax.pm | 2 +- 5 files changed, 103 insertions(+), 81 deletions(-) diff --git a/lib/WebGUI/Content/Shop.pm b/lib/WebGUI/Content/Shop.pm index 4ce60275e..65921ac70 100644 --- a/lib/WebGUI/Content/Shop.pm +++ b/lib/WebGUI/Content/Shop.pm @@ -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; } diff --git a/lib/WebGUI/Shop/Admin.pm b/lib/WebGUI/Shop/Admin.pm index 6cff0e4c0..429001755 100644 --- a/lib/WebGUI/Shop/Admin.pm +++ b/lib/WebGUI/Shop/Admin.pm @@ -28,7 +28,7 @@ These subroutines are available from this package: =cut -public session => my %session; +readonly session => my %session; #------------------------------------------------------------------- diff --git a/lib/WebGUI/Shop/Ship.pm b/lib/WebGUI/Shop/Ship.pm index 1486788ef..92acbe8a0 100644 --- a/lib/WebGUI/Shop/Ship.pm +++ b/lib/WebGUI/Shop/Ship.pm @@ -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 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")); } diff --git a/lib/WebGUI/Shop/ShipDriver.pm b/lib/WebGUI/Shop/ShipDriver.pm index 766b25cbd..3684cbd41 100644 --- a/lib/WebGUI/Shop/ShipDriver.pm +++ b/lib/WebGUI/Shop/ShipDriver.pm @@ -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}; } diff --git a/lib/WebGUI/Shop/Tax.pm b/lib/WebGUI/Shop/Tax.pm index 9a45c0c4c..c01b4807f 100644 --- a/lib/WebGUI/Shop/Tax.pm +++ b/lib/WebGUI/Shop/Tax.pm @@ -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')); }