Merge remote branch 'upstream/WebGUI8' into 8-merge

Conflicts:
	docs/gotcha.txt
	docs/previousVersion.sql
	lib/WebGUI/Asset/Wobject/GalleryAlbum.pm
	lib/WebGUI/Asset/Wobject/Navigation.pm
	lib/WebGUI/AssetLineage.pm
	lib/WebGUI/Config.pm
	lib/WebGUI/Form/Template.pm
	lib/WebGUI/Group.pm
	lib/WebGUI/VersionTag.pm
	lib/WebGUI/Workflow/Activity/TrashExpiredEvents.pm
	t/AdSpace.t
	t/Asset/AssetExportHtml.t
	t/Asset/AssetLineage.t
	t/Asset/Story.t
	t/Asset/Template/HTMLTemplateExpr.t
	t/Asset/Wobject/Gallery/00base.t
	t/Asset/Wobject/GalleryAlbum/00base.t
	t/Asset/Wobject/GalleryAlbum/ajax.t
	t/Asset/Wobject/InOutBoard.t
	t/Asset/Wobject/StoryArchive.t
	t/Asset/Wobject/Survey/ExpressionEngine.t
	t/Asset/Wobject/Survey/Reports.t
	t/AssetAspect/RssFeed.t
	t/Auth/mech.t
	t/Group.t
	t/Mail/Send.t
	t/Operation/AdSpace.t
	t/Session/ErrorHandler.t
	t/Session/Scratch.t
	t/Session/Url.t
	t/Shop/Cart.t
	t/Shop/Pay.t
	t/Shop/Ship.t
	t/Shop/ShipDriver.t
	t/Shop/TaxDriver/Generic.t
	t/Shop/Vendor.t
	t/VersionTag.t
	t/lib/WebGUI/Test.pm

docs/gotcha.txt

@@ -7,7 +7,6 @@ upgrading from one version to the next, or even between multiple
 versions. Be sure to heed the warnings contained herein as they will
 save you many hours of grief.
 
-<<<<<<< HEAD
 8.0.0
 --------------------------------------------------------------------
  * WebGUI 8 is not API compatible with WebGUI 7. If you have custom
@@ -17,11 +16,10 @@ save you many hours of grief.
  * WebGUI now requires the following modules
     - Moose
     - CHI
-=======
+
 7.9.8
 --------------------------------------------------------------------
      * Starting in WebGUI 7.9.4, the Net::Twitter module is required.
->>>>>>> master
 
 7.9.7
 --------------------------------------------------------------------

docs/migration.txt

@@ -6,7 +6,7 @@ The information contained herein documents the API changes that have occurred in
 
 
 WebGUI::Config
-=============
+==============
 WebGUI::Config->new has a new API.  Its WebGUI root parameter has been eliminated.  It now only accepts a config file as either an absolute path, or a path relative to WebGUI's etc directory.
 
 my $config = WebGUI::Config->new($filename);
@@ -14,10 +14,19 @@ my $config = WebGUI::Config->new($filename);
 
 
 WebGUI::Session
-=============
+===============
 WebGUI::Session->open has a new API.  Its WebGUI root parameter has been eliminated.  The config file it is given can be either an absolute path, or a path relative to WebGUI's etc directory.
 
-my $session = WebGUI::Session->open($configFile, $request, $server);
+my $session = WebGUI::Session->open($configFile);
+
+perldoc WebGUI::Session for more details about the arguments.
+
+
+WebGUI::Session::Env
+====================
+WebGUI::Session::Env has been moved into WebGUI::Session::Request.  A listing of replacements and equivalents follows:
+
+$session->env->getIp => $session->request->address
 
 
 
@@ -174,3 +183,19 @@ Asset API
 ----------
 ->get will still work, but will be slightly slower since inside it calls the direct Moose accessor.  Similarly,
 getId is slightly slower than ->assetId.
+
+WebGUI::Shop::Vendor
+====================
+Object properties are no longer written to the database when an object is created from scratch.  The write method needs
+to be called.
+
+WebGUI::Shop::AddressBook
+=========================
+Since create is now really new, there is no way to create an address book for an arbitrary userId.  To work around this,
+update the address book with the new userId after it has been created.
+
+WebGUI::Shop::Address
+=====================
+Object properties are no longer written to the database when an object is created from scratch.  The write method needs
+to be called.
+

docs/upgrades/upgrade_7.9.2-7.9.3.pl

@@ -1,176 +0,0 @@
-#!/usr/bin/env perl
-
-#-------------------------------------------------------------------
-# WebGUI is Copyright 2001-2009 Plain Black Corporation.
-#-------------------------------------------------------------------
-# Please read the legal notices (docs/legal.txt) and the license
-# (docs/license.txt) that came with this distribution before using
-# this software.
-#-------------------------------------------------------------------
-# http://www.plainblack.com                     info@plainblack.com
-#-------------------------------------------------------------------
-
-our ($webguiRoot);
-
-BEGIN {
-    $webguiRoot = "../..";
-    unshift (@INC, $webguiRoot."/lib");
-}
-
-use strict;
-use Getopt::Long;
-use WebGUI::Session;
-use WebGUI::Storage;
-use WebGUI::Asset;
-
-
-my $toVersion = '7.9.3';
-my $quiet; # this line required
-
-
-my $session = start(); # this line required
-
-reindexSiteForDefaultSynopsis( $session );
-addTopLevelWikiKeywords( $session );
-renameMapPointStateColumn( $session );
-
-finish($session); # this line required
-
-
-#----------------------------------------------------------------------------
-# Describe what our function does
-#sub exampleFunction {
-#    my $session = shift;
-#    print "\tWe're doing some stuff here that you should know about... " unless $quiet;
-#    # and here's our code
-#    print "DONE!\n" unless $quiet;
-#}
-
-#----------------------------------------------------------------------------
-sub renameMapPointStateColumn {
-    my $session = shift;
-    print "\tRename the MapPoint column state to region... " unless $quiet;
-
-    $session->db->write('ALTER TABLE MapPoint CHANGE state region char(35)');
-
-    print "Done.\n" unless $quiet;
-}
-
-
-#----------------------------------------------------------------------------
-sub addTopLevelWikiKeywords {
-    my $session = shift;
-    print "\tAdding top level keywords page to WikiMaster... " unless $quiet;
-
-    my $sth = $session->db->read('DESCRIBE `WikiMaster`');
-    while (my ($col) = $sth->array) {
-        if ($col eq 'topLevelKeywords') {
-            print "Skipped.\n" unless $quiet;
-            return;
-        }
-    }
-    $session->db->write('ALTER TABLE WikiMaster ADD COLUMN topLevelKeywords LONGTEXT');
-
-    print "Done.\n" unless $quiet;
-}
-
-
-#----------------------------------------------------------------------------
-# Reindex the site to clear out default synopsis
-sub reindexSiteForDefaultSynopsis {
-    my $session = shift;
-    print "\tRe-indexing site to clear out default synopses... " unless $quiet;
-
-    my $rs = $session->db->read("select assetId, className from asset where state='published'");
-    my @searchableAssetIds;
-    while (my ($id, $class) = $rs->array) {
-        my $asset = WebGUI::Asset->new($session,$id,$class);
-        if (defined $asset && $asset->get("state") eq "published" && ($asset->get("status") eq "approved" || $asset->get("status") eq "archived")) {
-            $asset->indexContent;
-            push (@searchableAssetIds, $id);
-        }
-    }
-
-    # delete indexes of assets that are no longer searchable
-    my $list = $session->db->quoteAndJoin(\@searchableAssetIds) if scalar(@searchableAssetIds);
-    $session->db->write("delete from assetIndex where assetId not in (".$list.")") if $list;
-
-    print "DONE!\n" unless $quiet;
-}
-
-# -------------- DO NOT EDIT BELOW THIS LINE --------------------------------
-
-#----------------------------------------------------------------------------
-# Add a package to the import node
-sub addPackage {
-    my $session     = shift;
-    my $file        = shift;
-
-    print "\tUpgrading package $file\n" unless $quiet;
-    # Make a storage location for the package
-    my $storage     = WebGUI::Storage->createTemp( $session );
-    $storage->addFileFromFilesystem( $file );
-
-    # Import the package into the import node
-    my $package = eval {
-        my $node = WebGUI::Asset->getImportNode($session);
-        $node->importPackage( $storage, {
-            overwriteLatest    => 1,
-            clearPackageFlag   => 1,
-            setDefaultTemplate => 1,
-        } );
-    };
-
-    if ($package eq 'corrupt') {
-        die "Corrupt package found in $file.  Stopping upgrade.\n";
-    }
-    if ($@ || !defined $package) {
-        die "Error during package import on $file: $@\nStopping upgrade\n.";
-    }
-
-    return;
-}
-
-#-------------------------------------------------
-sub start {
-    my $configFile;
-    $|=1; #disable output buffering
-    GetOptions(
-        'configFile=s'=>\$configFile,
-        'quiet'=>\$quiet
-    );
-    my $session = WebGUI::Session->open($webguiRoot,$configFile);
-    $session->user({userId=>3});
-    my $versionTag = WebGUI::VersionTag->getWorking($session);
-    $versionTag->set({name=>"Upgrade to ".$toVersion});
-    return $session;
-}
-
-#-------------------------------------------------
-sub finish {
-    my $session = shift;
-    updateTemplates($session);
-    my $versionTag = WebGUI::VersionTag->getWorking($session);
-    $versionTag->commit;
-    $session->db->write("insert into webguiVersion values (".$session->db->quote($toVersion).",'upgrade',".time().")");
-    $session->close();
-}
-
-#-------------------------------------------------
-sub updateTemplates {
-    my $session = shift;
-    return undef unless (-d "packages-".$toVersion);
-    print "\tUpdating packages.\n" unless ($quiet);
-    opendir(DIR,"packages-".$toVersion);
-    my @files = readdir(DIR);
-    closedir(DIR);
-    my $newFolder = undef;
-    foreach my $file (@files) {
-        next unless ($file =~ /\.wgpkg$/);
-        # Fix the filename to include a path
-        $file       = "packages-" . $toVersion . "/" . $file;
-        addPackage( $session, $file );
-    }
-}
-
-#vim:ft=perl

docs/upgrades/upgrade_7.9.3-7.9.4.pl

@@ -1,267 +0,0 @@
-#!/usr/bin/env perl
-
-#-------------------------------------------------------------------
-# WebGUI is Copyright 2001-2009 Plain Black Corporation.
-#-------------------------------------------------------------------
-# Please read the legal notices (docs/legal.txt) and the license
-# (docs/license.txt) that came with this distribution before using
-# this software.
-#-------------------------------------------------------------------
-# http://www.plainblack.com                     info@plainblack.com
-#-------------------------------------------------------------------
-
-our ($webguiRoot);
-
-BEGIN {
-    $webguiRoot = "../..";
-    unshift (@INC, $webguiRoot."/lib");
-}
-
-use strict;
-use Getopt::Long;
-use WebGUI::Session;
-use WebGUI::Storage;
-use WebGUI::Asset;
-use WebGUI::Asset::WikiPage;
-use WebGUI::Exception;
-use WebGUI::Shop::Pay;
-
-
-my $toVersion = '7.9.4';
-my $quiet; # this line required
-
-
-my $session = start(); # this line required
-
-# upgrade functions go here
-addWikiSubKeywords($session);
-addSynopsistoEachWikiPage($session);
-dropVisitorAddressBooks($session);
-alterCartTable($session);
-alterAddressBookTable($session);
-addWizardHandler( $session );
-addTemplateExampleImage( $session );
-addPayDriverTemplates( $session );
-
-finish($session); # this line required
-
-
-#----------------------------------------------------------------------------
-# Describe what our function does
-#sub exampleFunction {
-#    my $session = shift;
-#    print "\tWe're doing some stuff here that you should know about... " unless $quiet;
-#    # and here's our code
-#    print "DONE!\n" unless $quiet;
-#}
-
-#----------------------------------------------------------------------------
-# Add example images to templates
-sub addTemplateExampleImage {
-    my $session = shift;
-    print "\tAdding example image field to template... " unless $quiet;
-
-    $session->db->write( q{
-        ALTER TABLE template ADD storageIdExample CHAR(22)
-    } );
-
-    print "DONE!\n" unless $quiet;
-}
-
-#----------------------------------------------------------------------------
-
-sub addWizardHandler {
-    my ( $sesssion ) = @_;
-    print "\tAdding WebGUI::Wizard... " unless $quiet;
-
-    if ( !grep { $_ eq 'WebGUI::Content::Wizard' } @{$session->config->get('contentHandlers')} ) {
-        # Find the place of Operation and add before
-        my @handlers = ();
-        for my $handler ( @{$session->config->get('contentHandlers')} ) {
-            if ( $handler eq 'WebGUI::Content::Operation' ) {
-                push @handlers, 'WebGUI::Content::Wizard';
-            }
-            push @handlers, $handler;
-        }
-        $session->config->set('contentHandlers',\@handlers);
-    }
-
-    print "DONE!\n" unless $quiet;
-}
-
-#----------------------------------------------------------------------------
-sub addWikiSubKeywords {
-    my $session = shift;
-    print "\tAdd the WikiMaster sub-keywords table... " unless $quiet;
-    # and here's our code
-    $session->db->write(<<EOSQL);
-CREATE TABLE IF NOT EXISTS WikiMasterKeywords (
-    assetId CHAR(22) binary not null,
-    keyword CHAR(64) not null,
-    subKeyword CHAR(64),
-    PRIMARY KEY (`assetId`,`keyword`, `subKeyword`),
-    KEY `assetId` (`assetId`),
-    KEY `keyword` (`keyword`),
-    KEY `subKeyword` (`subKeyword`)
-)
-EOSQL
-    print "DONE!\n" unless $quiet;
-}
-
-#----------------------------------------------------------------------------
-sub addSynopsistoEachWikiPage {
-    my $session = shift;
-    print "\tAdd a synopsis to each wiki page this may take a while... " unless $quiet;
-    my $pager = WebGUI::Asset::WikiPage->getIsa($session);
-    PAGE: while (1) {
-       my $page = eval {$pager->()};
-       next PAGE if Exception::Class->caught();
-       last PAGE unless $page;
-       my ($synopsis) = $page->getSynopsisAndContent(undef, $page->get('content'));
-       $page->update({synopsis => $synopsis});
-    }
-    # and here's our code
-    print "DONE!\n" unless $quiet;
-}
-
-#----------------------------------------------------------------------------
-sub dropVisitorAddressBooks {
-    my $session = shift;
-    print "\tDrop AddressBooks owned by Visitor... " unless $quiet;
-    my $sth = $session->db->read(q|SELECT addressBookId FROM addressBook where userId='1'|);
-    BOOK: while (my ($addressBookId) = $sth->array) {
-        my $book = eval { WebGUI::Shop::AddressBook->new($session, $addressBookId); };
-        next BOOK if Exception::Class->caught();
-        $book->delete;
-    }
-    print "DONE!\n" unless $quiet;
-}
-
-#----------------------------------------------------------------------------
-sub alterAddressBookTable {
-    my $session = shift;
-    print "\tDrop sessionId from the Address Book database table... " unless $quiet;
-    # and here's our code
-    $session->db->write("ALTER TABLE addressBook DROP COLUMN sessionId");
-    print "DONE!\n" unless $quiet;
-}
-
-#----------------------------------------------------------------------------
-sub alterCartTable {
-    my $session = shift;
-    print "\tAdd billing address column to the Cart table... " unless $quiet;
-    # and here's our code
-    $session->db->write("ALTER TABLE cart ADD COLUMN billingAddressId CHAR(22)");
-    $session->db->write("ALTER TABLE cart ADD COLUMN gatewayId        CHAR(22)");
-    print "DONE!\n" unless $quiet;
-}
-
-#----------------------------------------------------------------------------
-sub addPayDriverTemplates {
-    my $session = shift;
-    print "\tAdd templates to the Payment Drivers that need them... " unless $quiet;
-    # and here's our code
-    my $pay = WebGUI::Shop::Pay->new($session);
-    my @gateways = @{ $pay->getPaymentGateways };
-    GATEWAY: foreach my $gateway (@gateways) {
-        next GATEWAY unless $gateway;
-        my $properties = $gateway->get;
-        if ($gateway->isa('WebGUI::Shop::PayDriver::Cash')) {
-            $properties->{summaryTemplateId} = '30h5rHxzE_Q0CyI3Gg7EJw';
-        }
-        elsif ($gateway->isa('WebGUI::Shop::PayDriver::ITransact')) {
-            ##Nothing to do.  This template was only changed, not added.
-        }
-        elsif ($gateway->isa('WebGUI::Shop::PayDriver::Ogone')) {
-            $properties->{summaryTemplateId} = 'jysVZeUR0Bx2NfrKs5sulg';
-        }
-        elsif ($gateway->isa('WebGUI::Shop::PayDriver::PayPal::PayPalStd')) {
-            $properties->{summaryTemplateId} = '300AozDaeveAjB_KN0ljlQ';
-        }
-        elsif ($gateway->isa('WebGUI::Shop::PayDriver::PayPal::ExpressCheckout')) {
-            $properties->{summaryTemplateId} = 'GqnZPB0gLoZmqQzYFaq7bg';
-        }
-        else {
-            die "Unknown payment driver type found.  Unable to automatically upgrade.\n";
-        }
-        $gateway->update($properties);
-    }
-    print "DONE!\n" unless $quiet;
-}
-
-# -------------- DO NOT EDIT BELOW THIS LINE --------------------------------
-
-#----------------------------------------------------------------------------
-# Add a package to the import node
-sub addPackage {
-    my $session     = shift;
-    my $file        = shift;
-
-    print "\tUpgrading package $file\n" unless $quiet;
-    # Make a storage location for the package
-    my $storage     = WebGUI::Storage->createTemp( $session );
-    $storage->addFileFromFilesystem( $file );
-
-    # Import the package into the import node
-    my $package = eval {
-        my $node = WebGUI::Asset->getImportNode($session);
-        $node->importPackage( $storage, {
-            overwriteLatest    => 1,
-            clearPackageFlag   => 1,
-            setDefaultTemplate => 1,
-        } );
-    };
-
-    if ($package eq 'corrupt') {
-        die "Corrupt package found in $file.  Stopping upgrade.\n";
-    }
-    if ($@ || !defined $package) {
-        die "Error during package import on $file: $@\nStopping upgrade\n.";
-    }
-
-    return;
-}
-
-#-------------------------------------------------
-sub start {
-    my $configFile;
-    $|=1; #disable output buffering
-    GetOptions(
-        'configFile=s'=>\$configFile,
-        'quiet'=>\$quiet
-    );
-    my $session = WebGUI::Session->open($webguiRoot,$configFile);
-    $session->user({userId=>3});
-    my $versionTag = WebGUI::VersionTag->getWorking($session);
-    $versionTag->set({name=>"Upgrade to ".$toVersion});
-    return $session;
-}
-
-#-------------------------------------------------
-sub finish {
-    my $session = shift;
-    updateTemplates($session);
-    my $versionTag = WebGUI::VersionTag->getWorking($session);
-    $versionTag->commit;
-    $session->db->write("insert into webguiVersion values (".$session->db->quote($toVersion).",'upgrade',".time().")");
-    $session->close();
-}
-
-#-------------------------------------------------
-sub updateTemplates {
-    my $session = shift;
-    return undef unless (-d "packages-".$toVersion);
-    print "\tUpdating packages.\n" unless ($quiet);
-    opendir(DIR,"packages-".$toVersion);
-    my @files = readdir(DIR);
-    closedir(DIR);
-    my $newFolder = undef;
-    foreach my $file (@files) {
-        next unless ($file =~ /\.wgpkg$/);
-        # Fix the filename to include a path
-        $file       = "packages-" . $toVersion . "/" . $file;
-        addPackage( $session, $file );
-    }
-}
-
-#vim:ft=perl

docs/upgrades/upgrade_7.9.4-7.9.5.pl

@@ -1,207 +0,0 @@
-#!/usr/bin/env perl
-
-#-------------------------------------------------------------------
-# WebGUI is Copyright 2001-2009 Plain Black Corporation.
-#-------------------------------------------------------------------
-# Please read the legal notices (docs/legal.txt) and the license
-# (docs/license.txt) that came with this distribution before using
-# this software.
-#-------------------------------------------------------------------
-# http://www.plainblack.com                     info@plainblack.com
-#-------------------------------------------------------------------
-
-our ($webguiRoot);
-
-BEGIN {
-    $webguiRoot = "../..";
-    unshift (@INC, $webguiRoot."/lib");
-}
-
-use strict;
-use Getopt::Long;
-use WebGUI::Session;
-use WebGUI::Storage;
-use WebGUI::Asset;
-use WebGUI::Workflow::Instance;
-
-
-my $toVersion = '7.9.5';
-my $quiet; # this line required
-
-
-my $session = start(); # this line required
-
-# upgrade functions go here
-modifySortItems( $session );
-fixRequestForApprovalScratch($session);
-addRejectNoticeSetting($session);
-updateGroupGroupingsTable($session);
-installNewCSUnsubscribeTemplate($session);
-
-finish($session); # this line required
-
-#----------------------------------------------------------------------------
-# Describe what our function does
-#sub exampleFunction {
-#    my $session = shift;
-#    print "\tWe're doing some stuff here that you should know about... " unless $quiet;
-#    # and here's our code
-#    print "DONE!\n" unless $quiet;
-#}
-
-#----------------------------------------------------------------------------
-# Adds setting which allows users to set whether or not to send reject notices
-sub addRejectNoticeSetting {
-    my $session = shift;
-    print "\tAdding reject notice setting... " unless $quiet;
-    $session->setting->add('sendRejectNotice',1);
-    print "DONE!\n" unless $quiet;
-}
-
-#----------------------------------------------------------------------------
-sub installNewCSUnsubscribeTemplate {
-    my $session = shift;
-    print "\tAdding new unsubscribe template to the CS... " unless $quiet;
-    $session->db->write(q|ALTER TABLE Collaboration ADD COLUMN unsubscribeTemplateId CHAR(22) NOT NULL|);
-    $session->db->write(q|UPDATE Collaboration set unsubscribeTemplateId='default_CS_unsubscribe'|);
-    print "DONE!\n" unless $quiet;
-}
-
-#----------------------------------------------------------------------------
-# Add keys and indicies to groupGroupings to help speed up group queries
-sub updateGroupGroupingsTable {
-    my $session = shift;
-    print "\tAdding primary key and indicies to groupGroupings table... " unless $quiet;
-    my $sth = $session->db->read('show create table groupGroupings');
-    my ($field,$stmt) = $sth->array;
-    $sth->finish;
-    unless ($stmt =~ m/PRIMARY KEY/i) {
-        $session->db->write("alter table groupGroupings add primary key (groupId,inGroup)");
-    }
-    unless ($stmt =~ m/KEY `inGroup`/i) {
-        $session->db->write("alter table groupGroupings add index inGroup (inGroup)");
-    }
-    print "DONE!\n" unless $quiet;
-}
-
-
-#----------------------------------------------------------------------------
-# Describe what our function does
-sub fixRequestForApprovalScratch {
-    my $session = shift;
-    print "\tCorrect RequestApprovalForVersionTag workflow instance data with leading commas... " unless $quiet;
-    # and here's our code
-    my $instances = WebGUI::Workflow::Instance->getAllInstances($session);
-    INSTANCE: foreach my $instance (@{ $instances }) {
-        my $messageId = $instance->getScratch('messageId');
-        next INSTANCE unless $messageId;
-        $messageId =~ s/^,//;
-        $instance->setScratch('messageId', $messageId);
-    }
-    print "DONE!\n" unless $quiet;
-}
-
-#----------------------------------------------------------------------------
-# Changes sortItems to a SelectBox
-sub modifySortItems {
-    my $session = shift;
-    print "\tUpdating SyndicatedContent...\n" unless $quiet;
-
-    require WebGUI::Form::SelectBox;
-
-    print "\t\tModifying table...\n" unless $quiet;
-    my $type = WebGUI::Form::SelectBox->getDatabaseFieldType;
-    $session->db->write("ALTER TABLE SyndicatedContent MODIFY sortItems $type");
-
-    print "\t\tConverting old values..." unless $quiet;
-    $session->db->write(q{
-        UPDATE SyndicatedContent
-        SET    sortItems = 'none'
-        WHERE  sortItems <> '1'
-    });
-    $session->db->write(q{
-        UPDATE SyndicatedContent
-        SET    sortItems = 'pubDate_des'
-        WHERE  sortItems = '1'
-    });
-
-    # and here's our code
-    print "DONE!\n" unless $quiet;
-}
-
-# -------------- DO NOT EDIT BELOW THIS LINE --------------------------------
-
-#----------------------------------------------------------------------------
-# Add a package to the import node
-sub addPackage {
-    my $session     = shift;
-    my $file        = shift;
-
-    print "\tUpgrading package $file\n" unless $quiet;
-    # Make a storage location for the package
-    my $storage     = WebGUI::Storage->createTemp( $session );
-    $storage->addFileFromFilesystem( $file );
-
-    # Import the package into the import node
-    my $package = eval {
-        my $node = WebGUI::Asset->getImportNode($session);
-        $node->importPackage( $storage, {
-            overwriteLatest    => 1,
-            clearPackageFlag   => 1,
-            setDefaultTemplate => 1,
-        } );
-    };
-
-    if ($package eq 'corrupt') {
-        die "Corrupt package found in $file.  Stopping upgrade.\n";
-    }
-    if ($@ || !defined $package) {
-        die "Error during package import on $file: $@\nStopping upgrade\n.";
-    }
-
-    return;
-}
-
-#-------------------------------------------------
-sub start {
-    my $configFile;
-    $|=1; #disable output buffering
-    GetOptions(
-        'configFile=s'=>\$configFile,
-        'quiet'=>\$quiet
-    );
-    my $session = WebGUI::Session->open($webguiRoot,$configFile);
-    $session->user({userId=>3});
-    my $versionTag = WebGUI::VersionTag->getWorking($session);
-    $versionTag->set({name=>"Upgrade to ".$toVersion});
-    return $session;
-}
-
-#-------------------------------------------------
-sub finish {
-    my $session = shift;
-    updateTemplates($session);
-    my $versionTag = WebGUI::VersionTag->getWorking($session);
-    $versionTag->commit;
-    $session->db->write("insert into webguiVersion values (".$session->db->quote($toVersion).",'upgrade',".time().")");
-    $session->close();
-}
-
-#-------------------------------------------------
-sub updateTemplates {
-    my $session = shift;
-    return undef unless (-d "packages-".$toVersion);
-    print "\tUpdating packages.\n" unless ($quiet);
-    opendir(DIR,"packages-".$toVersion);
-    my @files = readdir(DIR);
-    closedir(DIR);
-    my $newFolder = undef;
-    foreach my $file (@files) {
-        next unless ($file =~ /\.wgpkg$/);
-        # Fix the filename to include a path
-        $file       = "packages-" . $toVersion . "/" . $file;
-        addPackage( $session, $file );
-    }
-}
-
-#vim:ft=perl

docs/upgrades/upgrade_7.9.5-7.9.6.pl

@@ -1,161 +0,0 @@
-#!/usr/bin/env perl
-
-#-------------------------------------------------------------------
-# WebGUI is Copyright 2001-2009 Plain Black Corporation.
-#-------------------------------------------------------------------
-# Please read the legal notices (docs/legal.txt) and the license
-# (docs/license.txt) that came with this distribution before using
-# this software.
-#-------------------------------------------------------------------
-# http://www.plainblack.com                     info@plainblack.com
-#-------------------------------------------------------------------
-
-our ($webguiRoot);
-
-BEGIN {
-    $webguiRoot = "../..";
-    unshift (@INC, $webguiRoot."/lib");
-}
-
-use strict;
-use Getopt::Long;
-use WebGUI::Session;
-use WebGUI::Storage;
-use WebGUI::Asset;
-
-
-my $toVersion = '7.9.6';
-my $quiet; # this line required
-
-
-my $session = start(); # this line required
-
-# upgrade functions go here
-fixConvertUTCMacroName($session);
-dropOldEMSTableColumn($session);
-addIndexForInbox($session);
-
-finish($session); # this line required
-
-
-#----------------------------------------------------------------------------
-# Describe what our function does
-#sub exampleFunction {
-#    my $session = shift;
-#    print "\tWe're doing some stuff here that you should know about... " unless $quiet;
-#    # and here's our code
-#    print "DONE!\n" unless $quiet;
-#}
-
-#----------------------------------------------------------------------------
-# Add keys and indicies to groupGroupings to help speed up group queries
-sub addIndexForInbox {
-    my $session = shift;
-    print "\tAdding index to inbox_messageState... " unless $quiet;
-    my $sth = $session->db->read('show create table inbox_messageState');
-    my ($field,$stmt) = $sth->array;
-    $sth->finish;
-    unless ($stmt =~ m/KEY `userId_deleted_isRead`/i) {
-        $session->db->write("alter table inbox_messageState add index userId_deleted_isRead (userId,deleted,isRead)");
-    }
-    print "DONE!\n" unless $quiet;
-}
-
-#----------------------------------------------------------------------------
-# Describe what our function does
-sub fixConvertUTCMacroName {
-    my $session = shift;
-    print "\tFix the name of the ConvertUTCToTZ macro in the config file... " unless $quiet;
-    $session->config->deleteFromHash('macros', 'ConvertToUTC');
-    $session->config->addToHash('macros', 'ConvertUTCToTZ', 'ConvertUTCToTZ');
-    # and here's our code
-    print "DONE!\n" unless $quiet;
-}
-
-#----------------------------------------------------------------------------
-# Describe what our function does
-sub dropOldEMSTableColumn {
-    my $session = shift;
-    print "\tDrop an old column from the EventMangementSystem table that is no longer used... " unless $quiet;
-    $session->db->write(q|ALTER TABLE EventManagementSystem DROP COLUMN groupToApproveEvents|);
-    # and here's our code
-    print "DONE!\n" unless $quiet;
-}
-
-
-# -------------- DO NOT EDIT BELOW THIS LINE --------------------------------
-
-#----------------------------------------------------------------------------
-# Add a package to the import node
-sub addPackage {
-    my $session     = shift;
-    my $file        = shift;
-
-    print "\tUpgrading package $file\n" unless $quiet;
-    # Make a storage location for the package
-    my $storage     = WebGUI::Storage->createTemp( $session );
-    $storage->addFileFromFilesystem( $file );
-
-    # Import the package into the import node
-    my $package = eval {
-        my $node = WebGUI::Asset->getImportNode($session);
-        $node->importPackage( $storage, {
-            overwriteLatest    => 1,
-            clearPackageFlag   => 1,
-            setDefaultTemplate => 1,
-        } );
-    };
-
-    if ($package eq 'corrupt') {
-        die "Corrupt package found in $file.  Stopping upgrade.\n";
-    }
-    if ($@ || !defined $package) {
-        die "Error during package import on $file: $@\nStopping upgrade\n.";
-    }
-
-    return;
-}
-
-#-------------------------------------------------
-sub start {
-    my $configFile;
-    $|=1; #disable output buffering
-    GetOptions(
-        'configFile=s'=>\$configFile,
-        'quiet'=>\$quiet
-    );
-    my $session = WebGUI::Session->open($webguiRoot,$configFile);
-    $session->user({userId=>3});
-    my $versionTag = WebGUI::VersionTag->getWorking($session);
-    $versionTag->set({name=>"Upgrade to ".$toVersion});
-    return $session;
-}
-
-#-------------------------------------------------
-sub finish {
-    my $session = shift;
-    updateTemplates($session);
-    my $versionTag = WebGUI::VersionTag->getWorking($session);
-    $versionTag->commit;
-    $session->db->write("insert into webguiVersion values (".$session->db->quote($toVersion).",'upgrade',".time().")");
-    $session->close();
-}
-
-#-------------------------------------------------
-sub updateTemplates {
-    my $session = shift;
-    return undef unless (-d "packages-".$toVersion);
-    print "\tUpdating packages.\n" unless ($quiet);
-    opendir(DIR,"packages-".$toVersion);
-    my @files = readdir(DIR);
-    closedir(DIR);
-    my $newFolder = undef;
-    foreach my $file (@files) {
-        next unless ($file =~ /\.wgpkg$/);
-        # Fix the filename to include a path
-        $file       = "packages-" . $toVersion . "/" . $file;
-        addPackage( $session, $file );
-    }
-}
-
-#vim:ft=perl

docs/upgrades/upgrade_7.9.6-7.9.7.pl

@@ -1,241 +0,0 @@
-#!/usr/bin/env perl
-
-#-------------------------------------------------------------------
-# WebGUI is Copyright 2001-2009 Plain Black Corporation.
-#-------------------------------------------------------------------
-# Please read the legal notices (docs/legal.txt) and the license
-# (docs/license.txt) that came with this distribution before using
-# this software.
-#-------------------------------------------------------------------
-# http://www.plainblack.com                     info@plainblack.com
-#-------------------------------------------------------------------
-
-our ($webguiRoot);
-
-BEGIN {
-    $webguiRoot = "../..";
-    unshift (@INC, $webguiRoot."/lib");
-}
-
-use strict;
-use Getopt::Long;
-use WebGUI::Session;
-use WebGUI::Storage;
-use WebGUI::Asset;
-use WebGUI::Asset::Wobject::Collaboration;
-use WebGUI::Exception;
-use WebGUI::Workflow::Cron;
-use WebGUI::Utility qw/isIn/;
-
-
-my $toVersion = '7.9.7';
-my $quiet; # this line required
-
-
-my $session = start(); # this line required
-
-# upgrade functions go here
-restoreDefaultCronJobs($session);
-restoreCsCronJobs($session);
-cleanup_inbox_messageStateTable($session);
-
-finish($session); # this line required
-
-
-#----------------------------------------------------------------------------
-# Describe what our function does
-#sub exampleFunction {
-#    my $session = shift;
-#    print "\tWe're doing some stuff here that you should know about... " unless $quiet;
-#    # and here's our code
-#    print "DONE!\n" unless $quiet;
-#}
-
-#----------------------------------------------------------------------------
-# Describe what our function does
-sub cleanup_inbox_messageStateTable {
-    my $session = shift;
-    print "\tDelete dead entries from the inbox_MessageState table.  This may take a long time... " unless $quiet;
-    # and here's our code
-    my $source = $session->db->read("select messageId from inbox_messageState s where not exists(select messageId from inbox where messageId = s.messageId)");
-    my $cleaner = $session->db->prepare("delete from inbox_messageState where messageId=?");
-    while (my ($messageId) = $source->array) {
-        $cleaner->execute([$messageId]);
-    }
-    $source->finish;
-    $cleaner->finish;
-    print "DONE!\n" unless $quiet;
-}
-
-#----------------------------------------------------------------------------
-# Describe what our function does
-sub restoreDefaultCronJobs {
-    my $session = shift;
-    # and here's our code
-    print "\tRestore missing default cron jobs that may have been deleted... " unless $quiet;
-    my $tasks = WebGUI::Workflow::Cron->getAllTasks($session);
-    my @taskIds = map { $_->getId } @{ $tasks };
-    if (! isIn('pbcron0000000000000001', @taskIds)) {
-        print "\n\t\tRestoring Daily Maintenance Task... " unless $quiet;
-        WebGUI::Workflow::Cron->create($session, {
-            title        => "Daily Maintenance", dayOfMonth   => '*',
-            enabled      => 1,                   monthOfYear  => '*',
-            runOnce      => 0,                   dayOfWeek    => '*',
-            minuteOfHour => 30,                  workflowId   => 'pbworkflow000000000001',
-            hourOfDay    => 23,                  priority     => 3,
-        },
-        'pbcron0000000000000001');
-    }
-    if (! isIn('pbcron0000000000000002', @taskIds)) {
-        print "\n\t\tRestoring Weekly Maintenance Task... " unless $quiet;
-        WebGUI::Workflow::Cron->create($session, {
-            title        => "Weekly Maintenance", dayOfMonth   => '*',
-            enabled      => 1,                    monthOfYear  => '*',
-            runOnce      => 0,                    dayOfWeek    => '0',
-            minuteOfHour => 30,                   workflowId   => 'pbworkflow000000000002',
-            hourOfDay    => 1,                    priority     => 3,
-        },
-        'pbcron0000000000000002');
-    }
-    if (! isIn('pbcron0000000000000003', @taskIds)) {
-        print "\n\t\tRestoring Hourly Maintenance Task... " unless $quiet;
-        WebGUI::Workflow::Cron->create($session, {
-            title        => "Hourly Maintenance", dayOfMonth   => '*',
-            enabled      => 1,                    monthOfYear  => '*',
-            runOnce      => 0,                    dayOfWeek    => '*',
-            minuteOfHour => 15,                   workflowId   => 'pbworkflow000000000004',
-            hourOfDay    => '*',                  priority     => 3,
-        },
-        'pbcron0000000000000003');
-    }
-    if (! isIn('pbcron0000000000000004', @taskIds)) {
-        print "\n\t\tRestoring Email Delivery Task... " unless $quiet;
-        WebGUI::Workflow::Cron->create($session, {
-            title        => "Send Queued Email Messages Every 5 Minutes",
-                                                  dayOfMonth   => '*',
-            enabled      => 1,                    monthOfYear  => '*',
-            runOnce      => 0,                    dayOfWeek    => '*',
-            minuteOfHour => '*/5',                workflowId   => 'pbworkflow000000000007',
-            hourOfDay    => '*',                  priority     => 3,
-        },
-        'pbcron0000000000000004');
-    }
-    print "DONE!\n" unless $quiet;
-}
-
-#----------------------------------------------------------------------------
-# Describe what our function does
-sub restoreCsCronJobs {
-    my $session = shift;
-    print "\tRestore missing Collaboration System cron jobs that may have been deleted... " unless $quiet;
-    my $i18n = WebGUI::International->new($session, "Asset_Collaboration");
-    my $getCs = WebGUI::Asset::Wobject::Collaboration->getIsa($session);
-    CS: while (1) {
-        my $cs = eval { $getCs->(); };
-        if (my $e = Exception::Class->caught()) {
-            $session->log->error($@);
-            next CS;
-        }
-        last CS unless $cs;
-        ##Do something useful with $product
-        my $cron = undef;
-        if ($cs->get("getMailCronId")) {
-            $cron = WebGUI::Workflow::Cron->new($session, $cs->get("getMailCronId"));
-        }
-        next CS if $cron;
-        $cron = WebGUI::Workflow::Cron->create($session, {
-                title        => $cs->getTitle." ".$i18n->get("mail"),
-                minuteOfHour => "*/".($cs->get("getMailInterval")/60),
-                className    => (ref $cs),
-                methodName   => "new",
-                parameters   => $cs->getId,
-                workflowId   => "csworkflow000000000001"
-                });
-        $cs->update({getMailCronId=>$cron->getId});
-        if ($cs->get("getMail")) {
-                $cron->set({enabled=>1,title=>$cs->getTitle." ".$i18n->get("mail"), minuteOfHour=>"*/".($cs->get("getMailInterval")/60)});
-        } else {
-                $cron->set({enabled=>0,title=>$cs->getTitle." ".$i18n->get("mail"), minuteOfHour=>"*/".($cs->get("getMailInterval")/60)});
-        }
-
-    }
-    print "DONE!\n" unless $quiet;
-}
-
-
-# -------------- DO NOT EDIT BELOW THIS LINE --------------------------------
-
-#----------------------------------------------------------------------------
-# Add a package to the import node
-sub addPackage {
-    my $session     = shift;
-    my $file        = shift;
-
-    print "\tUpgrading package $file\n" unless $quiet;
-    # Make a storage location for the package
-    my $storage     = WebGUI::Storage->createTemp( $session );
-    $storage->addFileFromFilesystem( $file );
-
-    # Import the package into the import node
-    my $package = eval {
-        my $node = WebGUI::Asset->getImportNode($session);
-        $node->importPackage( $storage, {
-            overwriteLatest    => 1,
-            clearPackageFlag   => 1,
-            setDefaultTemplate => 1,
-        } );
-    };
-
-    if ($package eq 'corrupt') {
-        die "Corrupt package found in $file.  Stopping upgrade.\n";
-    }
-    if ($@ || !defined $package) {
-        die "Error during package import on $file: $@\nStopping upgrade\n.";
-    }
-
-    return;
-}
-
-#-------------------------------------------------
-sub start {
-    my $configFile;
-    $|=1; #disable output buffering
-    GetOptions(
-        'configFile=s'=>\$configFile,
-        'quiet'=>\$quiet
-    );
-    my $session = WebGUI::Session->open($webguiRoot,$configFile);
-    $session->user({userId=>3});
-    my $versionTag = WebGUI::VersionTag->getWorking($session);
-    $versionTag->set({name=>"Upgrade to ".$toVersion});
-    return $session;
-}
-
-#-------------------------------------------------
-sub finish {
-    my $session = shift;
-    updateTemplates($session);
-    my $versionTag = WebGUI::VersionTag->getWorking($session);
-    $versionTag->commit;
-    $session->db->write("insert into webguiVersion values (".$session->db->quote($toVersion).",'upgrade',".time().")");
-    $session->close();
-}
-
-#-------------------------------------------------
-sub updateTemplates {
-    my $session = shift;
-    return undef unless (-d "packages-".$toVersion);
-    print "\tUpdating packages.\n" unless ($quiet);
-    opendir(DIR,"packages-".$toVersion);
-    my @files = readdir(DIR);
-    closedir(DIR);
-    my $newFolder = undef;
-    foreach my $file (@files) {
-        next unless ($file =~ /\.wgpkg$/);
-        # Fix the filename to include a path
-        $file       = "packages-" . $toVersion . "/" . $file;
-        addPackage( $session, $file );
-    }
-}
-
-#vim:ft=perl

docs/upgrades/upgrade_7.9.7-7.9.8.pl

@@ -1,190 +0,0 @@
-#!/usr/bin/env perl
-
-#-------------------------------------------------------------------
-# WebGUI is Copyright 2001-2009 Plain Black Corporation.
-#-------------------------------------------------------------------
-# Please read the legal notices (docs/legal.txt) and the license
-# (docs/license.txt) that came with this distribution before using
-# this software.
-#-------------------------------------------------------------------
-# http://www.plainblack.com                     info@plainblack.com
-#-------------------------------------------------------------------
-
-our ($webguiRoot);
-
-BEGIN {
-    $webguiRoot = "../..";
-    unshift (@INC, $webguiRoot."/lib");
-}
-
-use strict;
-use Getopt::Long;
-use WebGUI::Session;
-use WebGUI::Storage;
-use WebGUI::Asset;
-use WebGUI::Asset::Wobject::Collaboration;
-use WebGUI::Asset::Post::Thread;
-use WebGUI::ProfileField;
-
-my $toVersion = '7.9.8';
-my $quiet; # this line required
-
-my $session = start(); # this line required
-
-# upgrade functions go here
-changeFirstDayOfWeekDefault($session);
-updateLastPostCS($session);
-updateLastPostThread($session);
-addTwitterAuth( $session );
-
-finish($session); # this line required
-
-
-#----------------------------------------------------------------------------
-# Describe what our function does
-#sub exampleFunction {
-#    my $session = shift;
-#    print "\tWe're doing some stuff here that you should know about... " unless $quiet;
-#    # and here's our code
-#    print "DONE!\n" unless $quiet;
-#}
-
-#----------------------------------------------------------------------------
-# Add twitter auth and macro
-sub addTwitterAuth {
-    my $session = shift;
-    print "\tAdding twitter auth method... " unless $quiet;
-
-    $session->config->addToArray( 'authMethods', 'Twitter' );
-    $session->config->addToHash( 'macros', "TwitterLogin" => "TwitterLogin" );
-    $session->setting->set( 'twitterEnabled', 0 );
-    $session->setting->set( 'twitterTemplateIdChooseUsername', 'mfHGkp6t9gdclmzN33OEnw' );
-
-    print "DONE!\n" unless $quiet;
-}
-
-#----------------------------------------------------------------------------
-# Describe what our function does
-sub changeFirstDayOfWeekDefault {
-    my $session = shift;
-    print "\tMake the default for firstDayOfWeek a number instead of a string... " unless $quiet;
-    # and here's our code
-    my $profileField = WebGUI::ProfileField->new($session, 'firstDayOfWeek');
-    my $properties = $profileField->get();
-    $properties->{dataDefault} = 0;
-    $profileField->set($properties);
-    print "DONE!\n" unless $quiet;
-}
-
-#----------------------------------------------------------------------------
-# Describe what our function does
-sub updateLastPostCS {
-    my $session = shift;
-    print "\tUpdating last post information in every Collaboration System.  This could take a very long time... " unless $quiet;
-    # and here's our code
-    my $getCs = WebGUI::Asset::Wobject::Collaboration->getIsa($session);
-    CS: while (my $cs = eval { $getCs->() } ) {
-       next CS if Exception::Class->caught();
-       last CS if ! $cs;
-       next CS unless $cs->get('lastPostId');
-       my $lastPost = WebGUI::Asset->newByDynamicClass($session, $cs->get('lastPostId'));
-       next CS unless $lastPost && $lastPost->get('status') eq 'archived';
-       $lastPost->disqualifyAsLastPost;
-   }
-    print "DONE!\n" unless $quiet;
-}
-
-#----------------------------------------------------------------------------
-# Describe what our function does
-sub updateLastPostThread {
-    my $session = shift;
-    print "\tUpdating last post information in every Thread.  This could also take a very long time... " unless $quiet;
-    # and here's our code
-    my $getThread = WebGUI::Asset::Wobject::Collaboration->getIsa($session);
-    THREAD: while (my $thread = eval { $getThread->() } ) {
-       next THREAD if Exception::Class->caught();
-       last THREAD if ! $thread;
-       next THREAD unless $thread->get('lastPostId');
-       my $lastPost = WebGUI::Asset->newByDynamicClass($session, $thread->get('lastPostId'));
-       next THREAD unless $lastPost && $lastPost->get('status') eq 'archived';
-       $lastPost->disqualifyAsLastPost;
-   }
-    print "DONE!\n" unless $quiet;
-}
-
-# -------------- DO NOT EDIT BELOW THIS LINE --------------------------------
-
-#----------------------------------------------------------------------------
-# Add a package to the import node
-sub addPackage {
-    my $session     = shift;
-    my $file        = shift;
-
-    print "\tUpgrading package $file\n" unless $quiet;
-    # Make a storage location for the package
-    my $storage     = WebGUI::Storage->createTemp( $session );
-    $storage->addFileFromFilesystem( $file );
-
-    # Import the package into the import node
-    my $package = eval {
-        my $node = WebGUI::Asset->getImportNode($session);
-        $node->importPackage( $storage, {
-            overwriteLatest    => 1,
-            clearPackageFlag   => 1,
-            setDefaultTemplate => 1,
-        } );
-    };
-
-    if ($package eq 'corrupt') {
-        die "Corrupt package found in $file.  Stopping upgrade.\n";
-    }
-    if ($@ || !defined $package) {
-        die "Error during package import on $file: $@\nStopping upgrade\n.";
-    }
-
-    return;
-}
-
-#-------------------------------------------------
-sub start {
-    my $configFile;
-    $|=1; #disable output buffering
-    GetOptions(
-        'configFile=s'=>\$configFile,
-        'quiet'=>\$quiet
-    );
-    my $session = WebGUI::Session->open($webguiRoot,$configFile);
-    $session->user({userId=>3});
-    my $versionTag = WebGUI::VersionTag->getWorking($session);
-    $versionTag->set({name=>"Upgrade to ".$toVersion});
-    return $session;
-}
-
-#-------------------------------------------------
-sub finish {
-    my $session = shift;
-    updateTemplates($session);
-    my $versionTag = WebGUI::VersionTag->getWorking($session);
-    $versionTag->commit;
-    $session->db->write("insert into webguiVersion values (".$session->db->quote($toVersion).",'upgrade',".time().")");
-    $session->close();
-}
-
-#-------------------------------------------------
-sub updateTemplates {
-    my $session = shift;
-    return undef unless (-d "packages-".$toVersion);
-    print "\tUpdating packages.\n" unless ($quiet);
-    opendir(DIR,"packages-".$toVersion);
-    my @files = readdir(DIR);
-    closedir(DIR);
-    my $newFolder = undef;
-    foreach my $file (@files) {
-        next unless ($file =~ /\.wgpkg$/);
-        # Fix the filename to include a path
-        $file       = "packages-" . $toVersion . "/" . $file;
-        addPackage( $session, $file );
-    }
-}
-
-#vim:ft=perl

lib/WebGUI/Account/Inbox.pm

@@ -850,7 +850,7 @@ sub www_inviteUser {
 
     $var->{'submit_button'    }  = WebGUI::Form::submit($session,{});
     $var->{'form_footer'      }  = WebGUI::Form::formFooter($session, {});
-    $var->{'back_url'         }  = $session->env->get("HTTP_REFERER") || $var->{'view_inbox_url'};
+    $var->{'back_url'         }  = $session->request->referer || $var->{'view_inbox_url'};
 
     #Add common template variable for displaying the inbox
     $self->appendCommonVars($var);
@@ -1099,7 +1099,7 @@ sub www_sendMessage {
     my $messageId = $form->get("messageId");
     my $userId    = $form->get("userId");
     my $pageUrl   = $session->url->page;
-    my $backUrl   = $session->env->get("HTTP_REFERER") || $var->{'view_inbox_url'};
+    my $backUrl   = $session->request->referer || $var->{'view_inbox_url'};
     my $errorMsg  = "";
 
     if($messageId) {

lib/WebGUI/AdSpace.pm

@@ -52,7 +52,7 @@ sub countClick {
 	my $session = shift;
 	my $id = shift;
 	my ($url) = $session->db->quickArray("select url from advertisement where adId=?",[$id]);
-        return $url if $session->env->requestNotViewed();
+        return $url if $session->request->requestNotViewed();
 	$session->db->write("update advertisement set clicks=clicks+1 where adId=?",[$id]);
 	return $url;
 }
@@ -119,7 +119,7 @@ A boolean that tells the ad system not to count this impression if true.
 sub displayImpression {
 	my $self = shift;
 	my $dontCount = shift;
-        return '' if $self->session->env->requestNotViewed();
+        return '' if $self->session->request->requestNotViewed();
 	my ($id, $ad, $priority, $clicks, $clicksBought, $impressions, $impressionsBought) = $self->session->db->quickArray("select adId, renderedAd, priority, clicks, clicksBought, impressions, impressionsBought from advertisement where adSpaceId=? and isActive=1 order by nextInPriority asc limit 1",[$self->getId]);
 	unless ($dontCount) {
 		my $isActive = 1;

lib/WebGUI/Asset.pm

@@ -588,8 +588,8 @@ to SSL.
 sub checkView {
 	my $self = shift;
 	return $self->session->privilege->noAccess() unless $self->canView;
-	my ($conf, $env, $var, $http) = $self->session->quick(qw(config env var http));
-    if ($conf->get("sslEnabled") && $self->get("encryptPage") && ! $env->sslRequest) {
+	my ($conf, $var, $http) = $self->session->quick(qw(config var http));
+    if ($conf->get("sslEnabled") && $self->get("encryptPage") && ! $self->session->request->secure) {
         # getUrl already changes url to https if 'encryptPage'
         $http->setRedirect($self->getUrl);
         $http->sendHeader;
@@ -1726,7 +1726,7 @@ sub getWwwCacheKey {
     my $session  = $self->session;
     my $method   = shift;
     my $cacheKey = join '_', @_, $self->getId;
-    if ($session->env->sslRequest) {
+    if ($session->request->secure) {
         $cacheKey .= '_ssl';
     }
     return $cacheKey;

lib/WebGUI/Asset/File/GalleryFile.pm

@@ -697,7 +697,7 @@ sub processCommentEditForm {
                     ;
 
     my $visitorIp   = $session->user->isVisitor
-                    ? $session->env->get("REMOTE_ADDR")
+                    ? $session->request->remote_host
                     : undef
                     ;
 

lib/WebGUI/Asset/MatrixListing.pm

@@ -350,7 +350,7 @@ sub hasRated {
 
     my $hasRated = $self->session->db->quickScalar("select count(*) from MatrixListing_rating where
         ((userId=? and userId<>'1') or (userId='1' and ipAddress=?)) and listingId=?",
-        [$session->user->userId,$session->env->get("HTTP_X_FORWARDED_FOR"),$self->getId]);
+        [$session->user->userId,$session->request->env->{"HTTP_X_FORWARDED_FOR"}, $self->getId]);
     return $hasRated;
 
 }
@@ -372,7 +372,7 @@ sub incrementCounter {
     my $db      = $self->session->db;
     my $counter = shift;
     
-    my $currentIp = $self->session->env->get("HTTP_X_FORWARDED_FOR");
+    my $currentIp = $self->session->request->env->{"HTTP_X_FORWARDED_FOR"};
     
     unless ($self->get($counter."LastIp") && ($self->get($counter."LastIp") eq $currentIp)) {
         $self->update({ 
@@ -528,7 +528,7 @@ sub setRatings {
             $db->write("insert into MatrixListing_rating 
                 (userId, category, rating, timeStamp, listingId, ipAddress, assetId) values (?,?,?,?,?,?,?)",
                 [$session->user->userId,$category,$ratings->{$category},time(),$self->getId,
-                $session->env->get("HTTP_X_FORWARDED_FOR"),$matrixId]);
+                $session->request->env->{"HTTP_X_FORWARDED_FOR"}, $matrixId]);
         }
         my $sql     = "from MatrixListing_rating where listingId=? and category=?";
         my $sum     = $db->quickScalar("select sum(rating) $sql", [$self->getId,$category]);

lib/WebGUI/Asset/Post.pm

@@ -120,8 +120,8 @@ sub _fixReplyCount {
         orderByClause   => 'assetData.revisionDate desc',
         limit           => 1,
     } )->[0];
-
-    if (my $lastPost = WebGUI::Asset->newById( $self->session, $lastPostId ) ) {
+    my $lastPost = eval { WebGUI::Asset->newById( $self->session, $lastPostId ); };
+    if ( ! Exception::Class->caught() ) {
         $asset->incrementReplies( $lastPost->revisionDate, $lastPost->getId );
     }
     else {
@@ -293,23 +293,30 @@ the parent thread.
 =cut
 
 override cut => sub {
+    warn "post's cut";
     my $self = shift;
 
     # Fetch the Thread and CS before cutting the asset.
     my $thread  = $self->getThread;
+    warn "got thread";
     my $cs      = $thread->getParent;
+    warn "got cs";
 
     # Cut the asset
     my $result = super();
+    warn "called super";
 
     # If a post is being cut update the thread reply count first
     if ($thread->getId ne $self->getId) {
+        warn "calling _fixReplyCount on thread";
         $self->_fixReplyCount( $thread );
     }
 
     # Update the CS reply count. This step is also necessary when a Post is cut since the Thread's incrementReplies
     # also calls the CS's incrementReplies, possibly with the wrong last post Id.
+    warn "calling _fixReplyCount on cs";
     $self->_fixReplyCount( $cs );
+    warn "all should be well...?";
 
     return $result;
 };
@@ -823,7 +830,7 @@ sub hasRated {
         return 1 if $self->isPoster;
 	my $flag = 0;
 	if ($self->session->user->isVisitor) {
-        	($flag) = $self->session->db->quickArray("select count(*) from Post_rating where assetId=? and ipAddress=?",[$self->getId, $self->session->env->getIp]);
+        	($flag) = $self->session->db->quickArray("select count(*) from Post_rating where assetId=? and ipAddress=?",[$self->getId, $self->session->request->address]);
 	} else {
         	($flag) = $self->session->db->quickArray("select count(*) from Post_rating where assetId=? and userId=?",[$self->getId, $self->session->user->userId]);
 	}
@@ -888,7 +895,7 @@ sub insertUserPostRating {
 	$self->session->db->write("insert into Post_rating (assetId,userId,ipAddress,dateOfRating,rating) values (?,?,?,?,?)",
 		[$self->getId,
 		 $self->session->user->userId,
-		 $self->session->env->getIp,
+		 $self->session->request->address,
 		 time(),
 		 $rating,]
 	);
@@ -1367,7 +1374,7 @@ Updates the last post information in the parent Thread and CS if applicable.
 
 sub setStatusUnarchived {
     my ($self) = @_;
-    $self->update({status=>'approved'}) if ($self->get("status") eq "archived");
+    $self->update({status=>'approved'}) if ($self->status eq "archived");
     $self->qualifyAsLastPost;
 }
 

lib/WebGUI/Asset/Wobject/GalleryAlbum.pm

@@ -211,8 +211,9 @@ sub appendTemplateVarsFileLoop {
     my $assetIds    = shift;
     my $session     = $self->session;
 
-    for my $assetId (@$assetIds) {
-        my $asset = WebGUI::Asset->newById($session, $assetId);
+    ASSET: for my $assetId (@$assetIds) {
+        my $asset = eval { WebGUI::Asset->newById($session, $assetId); };
+        next ASSET if Exception::Class->caught();
         # Set the parent
         $asset->{_parent} = $self;
         push @{$var->{file_loop}}, $asset->getTemplateVars;

lib/WebGUI/Asset/Wobject/HttpProxy.pm

@@ -310,7 +310,7 @@ sub view {
 	return $self->processTemplate({},$self->templateId) 
 		unless ($proxiedUrl ne "");
 	
-	my $requestMethod = $self->session->env->get("REQUEST_METHOD") || "GET";
+	my $requestMethod = $self->session->request->method || "GET";
 	
 	### Do we have cached content to get?
     my $cache = $self->session->cache;
@@ -328,7 +328,7 @@ sub view {
 		REDIRECT: for my $redirect (0..4) { # We follow max 5 redirects to prevent bouncing/flapping
 			
 			my $userAgent = new LWP::UserAgent;
-			$userAgent->agent($self->session->env->get("HTTP_USER_AGENT"));
+			$userAgent->agent($self->session->request->user_agent);
 			$userAgent->timeout($self->timeout);
 			$userAgent->env_proxy;
 			

lib/WebGUI/Asset/Wobject/Poll.pm

@@ -203,7 +203,7 @@ sub _hasVoted {
 	my $self = shift;
 	my ($hasVoted) = $self->session->db->quickArray("select count(*) from Poll_answer 
 		where assetId=".$self->session->db->quote($self->getId)." and ((userId=".$self->session->db->quote($self->session->user->userId)."
-		and userId<>'1') or (userId=".$self->session->db->quote($self->session->user->userId)." and ipAddress='".$self->session->env->getIp."'))");
+		and userId<>'1') or (userId=".$self->session->db->quote($self->session->user->userId)." and ipAddress='".$self->session->request->address."'))");
 	return $hasVoted;
 }
 
@@ -545,7 +545,7 @@ sub www_vote {
 	my $self = shift;
 	my $u;
         if ($self->session->form->process("answer") ne "" && $self->session->user->isInGroup($self->get("voteGroup")) && !($self->_hasVoted())) {
-        	$self->setVote($self->session->form->process("answer"),$self->session->user->userId,$self->session->env->getIp);
+        	$self->setVote($self->session->form->process("answer"),$self->session->user->userId,$self->session->request->address);
 		if ($self->session->setting->get("useKarma")) {
 			$self->session->user->karma($self->get("karmaPerVote"),"Poll (".$self->getId.")","Voted on this poll.");
 		}

lib/WebGUI/Asset/Wobject/ProjectManager.pm

@@ -1044,7 +1044,7 @@ sub www_drawGanttChart {
 		}
 		
 		#Adjust top for MSIE
-		my $isMSIE = ($session->env->get("HTTP_USER_AGENT") =~ /msie/i);
+		my $isMSIE = ($session->env->request->user_agent =~ /msie/i);
 		my $divTop =  $isMSIE ? 45 : 45;
 		#Start at 45 px and add 20px as the start of the new task
 		#Set the propert mutiplier

lib/WebGUI/Asset/Wobject/Survey.pm

@@ -2045,7 +2045,7 @@ sub responseId {
     my $ignoreRevisionDate = $opts{ignoreRevisionDate};
 
     my $user = WebGUI::User->new( $self->session, $userId );
-    my $ip = $self->session->env->getIp;
+    my $ip = $self->session->request->address;
 
     my $responseId = $self->{responseId};
     return $responseId if $responseId;
@@ -2178,7 +2178,7 @@ sub canTakeSurvey {
     }
 
     my $maxResponsesPerUser = $self->maxResponsesPerUser;
-    my $ip                  = $self->session->env->getIp;
+    my $ip                  = $self->session->request->address;
     my $userId              = $self->session->user->userId();
     my $takenCount          = 0;
 

lib/WebGUI/Asset/Wobject/Thingy.pm

@@ -565,7 +565,7 @@ sub editThingDataSave {
     if ($thingDataId eq "new"){
         $thingData{dateCreated} = time();
         $thingData{createdById} = $session->user->userId;
-        $thingData{ipAddress} = $session->env->getIp;
+        $thingData{ipAddress} = $session->request->address;
     }
     else {
         %thingData = $session->db->quickHash("select * from ".$session->db->dbh->quote_identifier("Thingy_".$thingId)

lib/WebGUI/AssetCollateral/DataForm/Entry.pm

@@ -301,7 +301,7 @@ sub new {
     }
     else {
         $self->user($session->user);
-        $self->ipAddress($session->env->getIp);
+        $self->ipAddress($session->request->address);
         $self->submissionDate(WebGUI::DateTime->new($session, time));
         $entryData{id $self} = {};
     }

lib/WebGUI/AssetPackage.pm

@@ -161,6 +161,7 @@ sub importAssetData {
     WebGUI::Asset->loadModule( $class );
 
     my %properties = %{ $data->{properties} };
+    delete $properties{tagId};
     if ($options->{inheritPermissions}) {
         delete $properties{ownerUserId};
         delete $properties{groupIdView};
@@ -173,6 +174,13 @@ sub importAssetData {
         $properties{isDefault} = 1;
     }
 
+    if ($options->{clearPackageFlag}) {
+        $properties{isPackage} = 0;
+    }
+    if ($options->{setDefaultTemplate}) {
+        $properties{isDefault} = 1;
+    }
+
     my $asset = eval { $class->new($session, $id, $version); };
 
     if (! Exception::Class->caught()) { # update an existing revision

lib/WebGUI/Auth.pm

@@ -100,8 +100,8 @@ sub _logLogin {
             $_[0],
             $_[1],
             time(),
-            $self->session->env->getIp,
-            $self->session->env->get("HTTP_USER_AGENT"),
+            $self->session->request->address,
+            $self->session->request->user_agent,
             $self->session->getId,
             time(),
         ]
@@ -539,7 +539,7 @@ sub displayLogin {
         ) {
         my $returnUrl
             = $self->session->form->get('returnUrl')
-            || $self->session->url->page( $self->session->env->get('QUERY_STRING') )
+            || $self->session->url->page( $self->session->request->env->{'QUERY_STRING'} )
             ;
         $self->session->scratch->set("redirectAfterLogin", $returnUrl);
     }

lib/WebGUI/Auth/Twitter.pm

@@ -151,7 +151,7 @@ Get the template to choose a username
 sub getTemplateChooseUsername {
     my ( $self ) = @_;
     my $templateId  = $self->session->setting->get('twitterTemplateIdChooseUsername');
-    return WebGUI::Asset::Template->new( $self->session, $templateId );
+    return WebGUI::Asset->newById( $self->session, $templateId );
 }
 
 #----------------------------------------------------------------------------

lib/WebGUI/Config.pm

@@ -35,8 +35,6 @@ This package parses the WebGUI config file.
 
  use WebGUI::Config;
 
- WebGUI::Config->loadAllConfigs($webguiRoot);
- 
  my $configs = WebGUI::Config->readAllConfigs;
 
  my $config = WebGUI::Config->new($configFileName);
@@ -65,24 +63,6 @@ These subroutines are available from this package:
 
 #-------------------------------------------------------------------
 
-=head2 clearCache ( ) 
-
-Clear the cache of in-memory configuration files.  This is required by the upgrade script, which
-forks to run each upgrade.  When the child is reaped, the original is untouched, so that the
-next script in the line recieves an old, in-memory config, essentially undoing any config
-changes in the first upgrade script.
-
-This is a class method.
-
-=cut
-
-sub clearCache {
-	my $class = shift;
-    %config = ();
-}
-
-#-------------------------------------------------------------------
-
 =head2 getCookieName ( ) 
 
 Returns the cookie name defined in the config file. Returns "wgSession" if one isn't defined.
@@ -112,62 +92,22 @@ sub getCookieTTL {
 
 #-------------------------------------------------------------------
 
-=head2 loadAllConfigs ( webguiRoot )
-
-Reads all the config file data for all defined sites into an in-memory cache. This is a class method.
-
-=head3 webguiRoot
-
-The path to the WebGUI installation.
-
-=cut
-
-sub loadAllConfigs {
-	my $class = shift;
-	my $configs = $class->readAllConfigs;
-	foreach my $filename (keys %{$configs}) {
-		unless ($filename =~ /^demo\d/) {
-			print "\tLoading ".$filename."\n";	
-			$config{$filename} = $configs->{$filename};
-		}
-	}
-}
-
-
-#-------------------------------------------------------------------
-
-=head2 new ( webguiRoot , configFile [ , noCache ] )
+=head2 new ( configFile )
 
 Returns a hash reference containing the configuration data. It tries to get the data out of the memory cache first, but reads the config file directly if necessary.
 
-=head3 webguiRoot
-
-The path to the WebGUI installation.
-
 =head3 configFile
 
 The filename of the config file to read.
 
-=head3 noCache
-
-A boolean value that when set to true tells the config system not to store the config in an in memory cache, in case it's loaded again later. This is mostly used when loading utility configs, like spectre.conf.
-
 =cut
 
-around new => sub {
+around BUILDARGS => sub {
     my $orig = shift;
     my $class = shift;
     my $filename = shift;
-    my $noCache = shift;
     $filename = Cwd::realpath(File::Spec->rel2abs($filename, WebGUI::Paths->configBase));
-    if (exists $config{$filename}) {
-        return $config{$filename};
-    }
-    else {
-        my $self = $class->$orig($filename);
-        $config{$filename} = $self unless $noCache;
-        return $self;
-    }
+    return $class->$orig($filename);
 };
 
 #-------------------------------------------------------------------

lib/WebGUI/Content/Prefetch.pm

@@ -46,7 +46,7 @@ The content handler for this package.
 
 sub handler {
     my ($session) = @_;
-    if ($session->env->get("HTTP_X_MOZ") eq "prefetch") { # browser prefetch is a bad thing
+    if ($session->request->env->{"HTTP_X_MOZ"} eq "prefetch") { # browser prefetch is a bad thing
         $session->http->setStatus(403);
     }
     return undef;

lib/WebGUI/Exception.pm

@@ -286,13 +286,12 @@ use Exception::Class (
     },
 );
 
-
-
-
-
-
-
-
+{
+    package WebGUI::Error;
+    use overload '~~' => sub {
+        return $_[0]->isa($_[1]);
+    };
+}
 
 1;
 

lib/WebGUI/Form/Captcha.pm

@@ -111,7 +111,7 @@ sub getValue {
         my $ua = LWP::UserAgent->new;
         my $res = $ua->post('http://api-verify.recaptcha.net/verify', {
             privatekey  => $privKey,
-            remoteip    => $self->session->env->getIp,
+            remoteip    => $self->session->request->env->{REMOTE_ADDR},
             challenge   => $challenge,
             response    => $response,
         });
@@ -158,10 +158,9 @@ sub toHtml {
     my $self = shift;
 
     if ($self->session->setting->get('useRecaptcha')) {
-        my $env = $self->session->env;
         my $pubKey = $self->session->setting->get('recaptchaPublicKey');
         my $server = "http://api.recaptcha.net";
-        if ($env->sslRequest) {
+        if ($self->session->request->secure) {
             $server = "https://api-secure.recaptcha.net";
         }
         return

lib/WebGUI/Form/Template.pm

@@ -173,9 +173,9 @@ sub setOptions {
 
     #Remove entries from template list that the user does not have permission to view.
     for my $assetId ( keys %{$templateList} ) {
-        my $asset = WebGUI::Asset::Template->newById($self->session, $assetId);
-        if (!$asset->canView($self->session->user->userId)) {
-                delete $templateList->{$assetId};
+        my $asset = eval { WebGUI::Asset->newById($session, $assetId); };
+        if (!Exception::Class->caught() && !$asset->canView($self->session->user->userId)) {
+            delete $templateList->{$assetId};
         }
     }
 

lib/WebGUI/Friends.pm

@@ -15,7 +15,20 @@ package WebGUI::Friends;
 =cut
 
 use strict;
-use Class::InsideOut qw(id register public readonly);
+
+use Moose;
+
+has 'session' => (
+    is              => 'ro',
+    required        => 1,
+    weak_ref        => 1,
+);
+
+has 'user' => (
+    is              => 'ro',
+    required        => 1,
+);
+
 use WebGUI::DateTime;
 use WebGUI::HTML;
 use WebGUI::Inbox;
@@ -23,9 +36,6 @@ use WebGUI::International;
 use WebGUI::User;
 use WebGUI::Utility;
 
-readonly session    => my %session;
-readonly user       => my %user;
-
 =head1 NAME
 
 WebGUI::Friends
@@ -45,6 +55,20 @@ A user relationship management system.
 
 =cut
 
+around BUILDARGS => sub {
+    my $orig       = shift;
+    my $className  = shift;
+
+    ##Original arguments start here.
+    my $protoSession = $_[0];
+    if (blessed $protoSession && $protoSession->isa('WebGUI::Session')) {
+        my $protoUser = defined $_[1] ? $_[1] : $protoSession->user;
+        return $className->$orig(session => $protoSession, user => $protoUser,);
+    }
+    return $className->$orig(@_);
+};
+
+
 
 #-------------------------------------------------------------------
 
@@ -276,16 +300,6 @@ attached to the session.
 
 =cut
 
-sub new {
-    my $class       = shift;
-    my $session     = shift;
-    my $user        = shift || $session->user;
-    my $self        = register($class);
-    $session{id $self} = $session;
-    $user{id $self} = $user;
-    return $self;
-}
-
 #-------------------------------------------------------------------
 
 =head2 rejectAddRequest ( inviteId[,sendNotification] )

lib/WebGUI/Group.pm

@@ -283,7 +283,7 @@ sub clearCaches {
 	$stow->delete("groupObj");
 	$stow->delete("isInGroup");
 	$stow->delete("gotGroupsInGroup");
-    $session->stow->delete("gotGroupsForUser");
+    $stow->delete("gotGroupsForUser");
 }
 
 #-------------------------------------------------------------------

lib/WebGUI/Image/Font.pm

@@ -73,7 +73,7 @@ sub getFile {
 	if ($self->getStorageId) {
 		return WebGUI::Storage->get($self->session, $self->getStorageId)->getPath($self->getFilename);
 	} else {
-		return WebGUI::Paths->var . '/default.ttf';
+		return WebGUI::Paths->share . '/default.ttf';
 	}
 }
 

lib/WebGUI/Keyword.pm

@@ -15,7 +15,13 @@ package WebGUI::Keyword;
 =cut
 
 use strict;
-use Class::InsideOut qw(public register id);
+use Moose;
+
+has session => (
+    is              => 'ro',
+    required        => 1,
+);
+
 use HTML::TagCloud;
 use WebGUI::Paginator;
 
@@ -40,6 +46,17 @@ These methods are available from this class:
 
 =cut
 
+around BUILDARGS => sub {
+    my $orig       = shift;
+    my $className  = shift;
+
+    ##Original arguments start here.
+    my $protoSession = $_[0];
+    if (blessed $protoSession && $protoSession->isa('WebGUI::Session')) {
+        return $className->$orig(session => $protoSession);
+    }
+    return $className->$orig(@_);
+};
 
 #-------------------------------------------------------------------
 
@@ -49,9 +66,6 @@ Returns a reference to the current session.
 
 =cut
 
-public session => my %session;
-
-
 #-------------------------------------------------------------------
 
 =head2 deleteKeywordsForAsset ( $asset )
@@ -473,15 +487,6 @@ A reference to the current session.
 
 =cut
 
-sub new {
-    my $class = shift;
-    my $session = shift;
-    my $self = bless \do {my $s}, $class;
-    register($self);
-    $session{id $self} = $session;
-    return $self;
-}
-
 #-------------------------------------------------------------------
 
 =head2 replaceKeyword ( { currentKeyword => $keyword1, newKeyword => $keyword2 } ) 

lib/WebGUI/Macro/Env.pm

@@ -32,7 +32,8 @@ then undef will be returned.
 #-------------------------------------------------------------------
 sub process {
 	my $session = shift;
-	return $session->env->get(shift);
+    my $key     = shift;
+	return $session->request->env->{$key};
 }
 
 1;

lib/WebGUI/Macro/L_loginBox.pm

@@ -79,18 +79,18 @@ sub process {
         # A hidden field with the current URL
         my $returnUrl   = $session->url->page;
         if ( !$session->form->get("op") eq "auth" ) {
-            $returnUrl  .= '?' . $session->env->get( "QUERY_STRING" );
+            $returnUrl  .= '?' . $session->request->env->{ "QUERY_STRING" };
         }
         $var{'form.returnUrl'} 
             = WebGUI::Form::hidden( $session, {
                 name        => 'returnUrl',
-                value       => $session->url->page($session->env->get("QUERY_STRING")),
+                value       => $session->url->page($session->request->env->{"QUERY_STRING"}),
             });
             
         # Fix box size
         my $boxSize = $param[0];
         $boxSize = 12 unless ($boxSize);
-        if (index(lc($session->env->get("HTTP_USER_AGENT")),"msie") < 0) {
+        if (index(lc($session->request->user_agent),"msie") < 0) {
         	$boxSize = int($boxSize=$boxSize*2/3);
         }
 

lib/WebGUI/Macro/r_printable.pm

@@ -54,7 +54,7 @@ sub process {
 	my $append = 'op=makePrintable';
 	$temp = $session->url->page($append);
         $temp =~ s/\/\//\//;
-        $temp = $session->url->append($temp,$session->env->get("QUERY_STRING"));
+        $temp = $session->url->append($temp,$session->request->env->{"QUERY_STRING"});
 	if ($param[1] ne "") {
 		$temp = $session->url->append($temp,'styleId='.$param[1]);
 	}

lib/WebGUI/Middleware/Maintenance.pm

@@ -0,0 +1,64 @@
+package WebGUI::Middleware::Maintenance;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use strict;
+use parent qw(Plack::Middleware);
+
+
+=head1 NAME
+
+Package WebGUI::Content::Maintenance;
+
+=head1 DESCRIPTION
+
+A content handler that displays a maintenance page while upgrading.
+
+=head1 SYNOPSIS
+
+    enable '+WebGUI::Middleware::Maintenance';
+
+=head1 SUBROUTINES
+
+These subroutines are available from this package:
+
+=cut
+
+#-------------------------------------------------------------------
+
+=head2 handler ( session ) 
+
+The content handler for this package.
+
+=cut
+
+sub call {
+    my $self = shift;
+    my $env  = shift;
+    my $session = $env->{'webgui.session'};
+    my $upgradeState = $session->setting->get('upgradeState');
+    if ($upgradeState) {
+        if ($upgradeState eq WebGUI->VERSION) {
+            $session->setting->remove('upgradeState');
+        }
+        else {
+            return [ 503, ['Content-Type' => 'text/plain'], [ 'Service Unavailable' ] ];
+        }
+    }
+    return $self->app->($env);
+}
+
+1;
+

lib/WebGUI/Operation/Cron.pm

@@ -271,7 +271,7 @@ sub www_runCronJob {
         my $session = shift;
 	$session->http->setMimeType("text/plain");
 	$session->http->setCacheControl("none");
-	unless (isInSubnet($session->env->getIp, $session->config->get("spectreSubnets")) || canView($session)) {
+	unless (isInSubnet($session->request->address, $session->config->get("spectreSubnets")) || canView($session)) {
 		$session->errorHandler->security("make a Spectre cron job runner request, but we're only allowed to accept requests from ".join(",",@{$session->config->get("spectreSubnets")}).".");
         	return "error";
 	}

lib/WebGUI/Operation/Spectre.pm

@@ -59,7 +59,7 @@ sub www_spectreGetSiteData {
     if (!defined $subnets) {
         $subnets = [];
     }
-	if (!isInSubnet($session->env->getIp, $subnets)) {
+	if (!isInSubnet($session->request->address, $subnets)) {
 		$session->errorHandler->security("Tried to make a Spectre workflow data load request, but we're only allowed to accept requests from "
 			.join(",",@{$subnets}).".");
 	} 
@@ -181,7 +181,7 @@ sub www_spectreTest {
         $subnets = [];
     }
 
-    my $sessionIp = $session->env->getIp;
+    my $sessionIp = $session->request->address;
 	unless (isInSubnet($sessionIp, $subnets)) {
 		$session->errorHandler->security(
             sprintf "Tried to make a Spectre workflow runner request from %s, but we're only allowed to accept requests from %s",

lib/WebGUI/Operation/User.pm

@@ -141,7 +141,7 @@ sub canUseService {
     my ( $session ) = @_;
     my $subnets = $session->config->get('serviceSubnets');
     return 1 if !$subnets || !@{$subnets};
-    return 1 if WebGUI::Utility::isInSubnet( $session->env->getIp, $subnets );
+    return 1 if WebGUI::Utility::isInSubnet( $session->request->address, $subnets );
     return 0; # Don't go away mad, just go away
 }
 

lib/WebGUI/Operation/Workflow.pm

@@ -482,7 +482,7 @@ sub www_runWorkflow {
         my $session = shift;
 	$session->http->setMimeType("text/plain");
 	$session->http->setCacheControl("none");
-	unless (isInSubnet($session->env->getIp, $session->config->get("spectreSubnets")) || canRunWorkflow($session)) {
+	unless (isInSubnet($session->request->address, $session->config->get("spectreSubnets")) || canRunWorkflow($session)) {
 		$session->errorHandler->security("make a Spectre workflow runner request, but we're only allowed to accept requests from ".join(",",@{$session->config->get("spectreSubnets")}).".");
         	return "error";
 	}

lib/WebGUI/Paths.pm

@@ -85,7 +85,7 @@ Returns the base directory of the default site uploads content.
 
 Returns the file path of the default site create.sql script.
 
-=head2 var
+=head2 share
 
 Returns the base directory for WebGUI auxiliary files.
 
@@ -102,12 +102,12 @@ BEGIN {
         spectreConfig      => catfile($root, 'etc', 'spectre.conf'),
         preloadCustom      => catfile($root, 'etc', 'preload.custom'),
         preloadExclusions  => catfile($root, 'etc', 'preload.exclude'),
-        upgrades           => catdir($root, 'var', 'upgrades'),
+        upgrades           => catdir($root, 'share', 'upgrades'),
         extras             => catdir($root, 'www', 'extras'),
         defaultUploads     => catdir($root, 'www', 'uploads'),
-        defaultCreateSQL   => catdir($root, 'docs', 'create.sql'),
-        var                => catdir($root, 'var'),
-        defaultPSGI        => catdir($root, 'var', 'site.psgi'),
+        defaultCreateSQL   => catdir($root, 'share', 'create.sql'),
+        share              => catdir($root, 'share'),
+        defaultPSGI        => catdir($root, 'share', 'site.psgi'),
     );
     my $meta = Class::MOP::Class->initialize(__PACKAGE__);
     for my $sub (keys %paths) {
@@ -203,6 +203,7 @@ Returns the list of modules to exclude from preloading as an array.
 sub preloadExclude {
     my $class = shift;
     my @excludes = _readTextLines($class->preloadExclusions);
+    push @excludes, 'WebGUI::Upgrade', 'WebGUI::Upgrade::*';
     return @excludes;
 }
 

lib/WebGUI/Session.pm

@@ -20,11 +20,12 @@ use 5.010;
 use CHI;
 use File::Temp qw( tempdir );
 use Scalar::Util qw( weaken );
+use HTTP::Message::PSGI;
+use HTTP::Request::Common;
 use WebGUI::Config;
 use WebGUI::SQL;
 use WebGUI::User;
 use WebGUI::Session::DateTime;
-use WebGUI::Session::Env;
 use WebGUI::Session::ErrorHandler;
 use WebGUI::Session::Form;
 use WebGUI::Session::Http;
@@ -64,7 +65,6 @@ B<NOTE:> It is important to distinguish the difference between a WebGUI session
  $session->datetime
  $session->db
  $session->dbSlave
- $session->env
  $session->log
  $session->form
  $session->http
@@ -169,9 +169,15 @@ sub close {
 
 	# Kill circular references.  The literal list is so that the order
 	# can be explicitly shuffled as necessary.
-	foreach my $key (qw/_asset _datetime _icon _slave _db _env _form _http _id _output _privilege _scratch _setting _stow _style _url _user _var _cache _errorHandler _response _request/) {
+	foreach my $key (qw/_asset _datetime _icon _slave _db _form _http _id _output _privilege _scratch _setting _stow _style _url _user _var _cache _errorHandler _response _request/) {
 		delete $self->{$key};
 	}
+    $self->{closed} = 1;
+}
+
+sub closed {
+    my $self = shift;
+    return $self->{closed};
 }
 
 #-------------------------------------------------------------------
@@ -306,23 +312,6 @@ sub duplicate {
 }
 
 
-#-------------------------------------------------------------------
-
-=head2 env ( )
-
-Returns a WebGUI::Session::Env object.
-
-=cut
-
-sub env {
-	my $self = shift;
-	unless (exists $self->{_env}) {
-		$self->{_env} = WebGUI::Session::Env->new($self);
-	}
-	return $self->{_env};
-}
-
-
 #-------------------------------------------------------------------
 
 =head2 errorHandler ( )
@@ -480,15 +469,21 @@ sub open {
     my $self = { _config => $config };
     bless $self, $class;
 
-    if ($env) {
-        my $request = WebGUI::Session::Request->new($env);
-        $self->{_request} = $request;
-        $self->{_response} = $request->new_response( 200 );
-        
-        # Use the WebGUI::Session::Request object to look up the sessionId from cookies, if it
-        # wasn't given explicitly
-        $sessionId ||= $request->cookies->{$config->getCookieName};
+    ##No env was passed, so construct one
+    if (! $env) {
+        my $url = 'http://' . $config->get('sitename')->[0];
+        my $request = HTTP::Request::Common::GET($url);
+        $request->headers->user_agent('WebGUI');
+        $env = $request->to_psgi;
     }
+
+    my $request = WebGUI::Session::Request->new($env);
+    $self->{_request} = $request;
+    $self->{_response} = $request->new_response( 200 );
+    
+    # Use the WebGUI::Session::Request object to look up the sessionId from cookies, if it
+    # wasn't given explicitly
+    $sessionId ||= $request->cookies->{$config->getCookieName};
     
     # If the sessionId is still unset or is invalid, generate a new one
     if (!$sessionId || !$self->id->valid($sessionId)) {

lib/WebGUI/Session/Env.pm

@@ -1,193 +0,0 @@
-package WebGUI::Session::Env;
-
-=head1 LEGAL
-
- -------------------------------------------------------------------
-  WebGUI is Copyright 2001-2009 Plain Black Corporation.
- -------------------------------------------------------------------
-  Please read the legal notices (docs/legal.txt) and the license
-  (docs/license.txt) that came with this distribution before using
-  this software.
- -------------------------------------------------------------------
-  http://www.plainblack.com                     info@plainblack.com
- -------------------------------------------------------------------
-
-=cut
-
-use strict;
-
-=head1 NAME
-
-Package WebGUI::Session::Env
-
-=head1 DESCRIPTION
-
-This package allows you to reference environment variables.
-
-=head1 SYNOPSIS
-
-$env = WebGUI::Session::Env->new;
-
-$value = $env->get('REMOTE_ADDR');
-
-return 'not gonna see it' if $env->requestNotViewed() ;
-
-=head1 METHODS
-
-These methods are available from this package:
-
-=cut
-
-
-#-------------------------------------------------------------------
-
-=head2 callerIsSearchSite ( )
-
-Returns true if the remote address matches a site which is a known indexer or spider.
-
-=cut
-
-sub callerIsSearchSite {
-
-    my $self = shift;
-    my $remoteAddress = $self->getIp;
-
-    return 1 if $remoteAddress =~ /203\.87\.123\.1../    # Blaiz Enterprise Rawgrunt search
-             || $remoteAddress =~ /123\.113\.184\.2../   # Unknown Yahoo Robot
-             || $remoteAddress == '';
-
-    return 0;
-
-}
-
-
-#-------------------------------------------------------------------
-
-=head2 clientIsSpider ( )
-
-Returns true is the client/agent is a spider/indexer or some other non-human interface, determined
-by checking the user agent against a list of known spiders.
-
-=cut
-
-
-sub clientIsSpider {
-
-    my $self = shift;
-    my $userAgent = $self->get('HTTP_USER_AGENT');
-
-    return 1 if $userAgent eq ''
-             || $userAgent =~ m<(^wre\/|      # the WRE wget's http://localhost/ every 2-3 minutes 24 hours a day...
-                                 ^morpheus|
-                                 libwww|
-                                 s[pb]ider|
-                                 bot|
-                                 robo|
-                                 sco[ou]t|
-                                 crawl|
-                                 miner|
-                                 reaper|
-                                 finder|
-                                 search|
-                                 engine|
-                                 download|
-                                 fetch|
-                                 scan|
-                                 slurp)>ix;
-
-    return 0;
-
-}
-
-#-------------------------------------------------------------------
-
-=head2 get( varName ) 
-
-Retrieves the current value of an environment variable.
-
-=head3 varName
-
-The name of the variable.
-
-=cut
-
-sub get {
-    my $self = shift;
-    my $var = shift;
-    return $$self->{$var};
-}
-
-
-#-------------------------------------------------------------------
-
-=head2 getIp ( )
-
-Returns the user's IP address.
-
-=cut
-
-sub getIp {
-    my $self = shift;
-    return $self->get('REMOTE_ADDR');
-}
-
-
-#-------------------------------------------------------------------
-
-=head2 new ( )
-
-Constructor. Returns an env object.
-
-=cut
-
-sub new {
-    my $class = shift;
-    my $session = shift;
-    my $env;
-    if ($session->request) {
-        $env = $session->request->env;
-    }
-    else {
-        $env = {};
-    }
-    return bless \$env, $class;
-}
-
-#-------------------------------------------------------------------
-
-=head2 requestNotViewed ( )
-
-Returns true is the client/agent is a spider/indexer or some other non-human interface
-
-=cut
-
-sub requestNotViewed {
-
-    my $self = shift;
-    return $self->clientIsSpider();
-        # || $self->callerIsSearchSite();   # this part is currently left out because
-                                            # it has minimal effect and does not manage
-                                            # IPv6 addresses.  it may be useful in the 
-                                            # future though
-
-}
-
-#-------------------------------------------------------------------
-
-=head2 sslRequest ( )
-
-Returns true if a https request was made.
-
-HTTP_SSLPROXY is set by mod_proxy in the WRE so that WebGUI knows that the original request
-was made via SSL.
-
-=cut
-
-sub sslRequest {
-    my $self = shift;
-    return $self->get('psgi.url_scheme') eq 'https';
-}
-
-
-1;
-

lib/WebGUI/Session/ErrorHandler.pm

@@ -253,7 +253,7 @@ sub security {
     my $self = shift;
     my $message = shift;
     @_ = ($self, $self->session->user->username." (".$self->session->user->userId.") connecting from "
-        .$self->session->env->getIp." attempted to ".$message);
+        .$self->session->request->address." attempted to ".$message);
     goto $self->can('warn');
 }
 

lib/WebGUI/Session/Request.pm

@@ -17,6 +17,68 @@ is created.
 
 =head1 METHODS
 
+=cut 
+
+#-------------------------------------------------------------------
+
+=head2 clientIsSpider ( )
+
+Returns true is the client/agent is a spider/indexer or some other non-human interface, determined
+by checking the user agent against a list of known spiders.
+
+=cut
+
+sub clientIsSpider {
+
+    my $self = shift;
+    my $userAgent = $self->user_agent;
+
+    return 1 if $userAgent eq ''
+             || $userAgent =~ m<(^wre\/|      # the WRE wget's http://localhost/ every 2-3 minutes 24 hours a day...
+                                 ^morpheus|
+                                 libwww|
+                                 s[pb]ider|
+                                 bot|
+                                 robo|
+                                 sco[ou]t|
+                                 crawl|
+                                 miner|
+                                 reaper|
+                                 finder|
+                                 search|
+                                 engine|
+                                 download|
+                                 fetch|
+                                 scan|
+                                 slurp)>ix;
+
+    return 0;
+
+}
+
+#-------------------------------------------------------------------
+
+=head2 callerIsSearchSite ( )
+
+Returns true if the remote address matches a site which is a known indexer or spider.
+
+=cut
+
+sub callerIsSearchSite {
+
+    my $self = shift;
+    my $remoteAddress = $self->address;
+
+    return 1 if $remoteAddress =~ /203\.87\.123\.1../    # Blaiz Enterprise Rawgrunt search
+             || $remoteAddress =~ /123\.113\.184\.2../   # Unknown Yahoo Robot
+             || $remoteAddress == '';
+
+    return 0;
+
+}
+
+#-------------------------------------------------------------------
+
 =head2 new_response ()
 
 Creates a new L<WebGUI::Session::Response> object.
@@ -32,9 +94,29 @@ sub new_response {
     return WebGUI::Session::Response->new(@_);
 }
 
+#-------------------------------------------------------------------
+
+=head2 requestNotViewed ( )
+
+Returns true is the client/agent is a spider/indexer or some other non-human interface
+
+=cut
+
+sub requestNotViewed {
+
+    my $self = shift;
+    return $self->clientIsSpider();
+        # || $self->callerIsSearchSite();   # this part is currently left out because
+                                            # it has minimal effect and does not manage
+                                            # IPv6 addresses.  it may be useful in the 
+                                            # future though
+
+}
+
+
 # This is only temporary
 sub TRACE { 
     shift->env->{'psgi.errors'}->print(join '', @_, "\n");
 }
 
-1;
+1;

lib/WebGUI/Session/Style.pm

@@ -131,7 +131,7 @@ sub useMobileStyle {
     if (! $session->setting->get('useMobileStyle')) {
         return $self->{_useMobileStyle} = 0;
     }
-    my $ua = $session->env->get('HTTP_USER_AGENT');
+    my $ua = $session->request->user_agent;
     for my $mobileUA (@{ $self->session->config->get('mobileUserAgents') }) {
         if ($ua =~ m/$mobileUA/) {
             return $self->{_useMobileStyle} = 1;

lib/WebGUI/Session/Url.pm

@@ -136,7 +136,7 @@ sub extras {
     my $cdnCfg = $self->session->config->get('cdn');
     if ( $cdnCfg and $cdnCfg->{'enabled'} and $cdnCfg->{'extrasCdn'} ) {
         unless ( $path and grep $path =~ m/$_/, @{ $cdnCfg->{'extrasExclude'} } ) {
-            if ($cdnCfg->{'extrasSsl'} && $self->session->env->sslRequest) {
+            if ($cdnCfg->{'extrasSsl'} && $self->session->request->secure) {
                 $url = $cdnCfg->{'extrasSsl'};
             }
             else {
@@ -258,7 +258,7 @@ Returns the URL of the page this request was refered from (no gateway, no query
 
 sub getRefererUrl {
 	my $self = shift;
-	my $referer = $self->session->env->get("HTTP_REFERER");
+	my $referer = $self->session->request->referer;
 	return undef unless ($referer);
 	my $url = $referer;
 	my $gateway = $self->session->config->get("gateway");
@@ -289,20 +289,20 @@ is not passed in, it will attempt to get one from the L<page> method, or finally
 sub forceSecureConnection {
     my $self = shift;
     my $url = shift;
-    my ($conf, $env, $http) = $self->session->quick(qw(config env http));
+    my ($conf, $http) = $self->session->quick(qw(config http));
    
-    if ($conf->get("sslEnabled") && !$env->sslRequest){
+    if ($conf->get("sslEnabled") && ! $self->session->request->secure){
    
-        $url = $self->session->url->page if(! $url);
-        $url = $env->get('QUERY_STRING') if(! $url);
+        my $query_string = $self->session->request->env->{'QUERY_STRING'};
+        $url = $url || $self->page || $query_string;
 
         my $siteURL = $self->getSiteURL();
 
         if($url !~ /^$siteURL/i){
             $url = $siteURL . $url;
         }
-        if($env->get('QUERY_STRING')){ 
-            $url .= "?". $env->get('QUERY_STRING');
+        if($query_string){ 
+            $url .= "?". $query_string;
         }
         if($url =~ /^http/i) {
             $url =~ s/^https?/https/i;
@@ -347,14 +347,14 @@ sub getSiteURL {
     unless ($self->{_siteUrl}) {
         my $site = "";
         my $sitenames = $self->session->config->get("sitename");
-        my ($http_host,$currentPort) = split(':', $self->session->env->get("HTTP_HOST"));
+        my ($http_host,$currentPort) = split(':', $self->session->request->env->{"HTTP_HOST"});
         if ($self->session->setting->get("hostToUse") eq "HTTP_HOST" and isIn($http_host,@{$sitenames})) {
                 $site = $http_host;
         } else {
                 $site = $sitenames->[0];
         }
         my $proto = "http://";
-        if ($self->session->env->sslRequest) {
+        if ($self->session->request->secure) {
                 $proto = "https://";
         }
 		my $port = "";

lib/WebGUI/Session/Var.pm

@@ -182,7 +182,7 @@ sub new {
             my $time = time();
             my $timeout = $session->setting->get("sessionTimeout");
 			$self->{_var}{lastPageView} = $time;
-			$self->{_var}{lastIP} = $session->env->getIp;
+			$self->{_var}{lastIP} = $session->request->address;
 			$self->{_var}{expires} = $time + $timeout;
             if ($self->{_var}{nextCacheFlush} > 0 && $self->{_var}{nextCacheFlush} < $time) {
                 delete $self->{_var}{nextCacheFlush};
@@ -247,7 +247,7 @@ sub start {
 	$self->{_var} = {
 		expires      => $time + $timeout,
 		lastPageView => $time,
-		lastIP       => $session->env->getIp,
+		lastIP       => $session->request->address,
 		adminOn      => 0,
 		userId       => $userId
 	};

lib/WebGUI/Shop/Address.pm

@@ -15,7 +15,85 @@ package WebGUI::Shop::Address;
 =cut
 
 use strict;
-use Class::InsideOut qw{ :std };
+use Moose;
+use WebGUI::Definition;
+
+property label => (
+    noFormPost => 1,
+    default    => '',
+);
+
+property firstName => (
+    noFormPost => 1,
+    default    => '',
+);
+
+property lastName => (
+    noFormPost => 1,
+    default    => '',
+);
+
+property address1 => (
+    noFormPost => 1,
+    default    => '',
+);
+
+property address2 => (
+    noFormPost => 1,
+    default    => '',
+);
+
+property address3 => (
+    noFormPost => 1,
+    default    => '',
+);
+
+property city => (
+    noFormPost => 1,
+    default    => '',
+);
+
+property state => (
+    noFormPost => 1,
+    default    => '',
+);
+
+property code => (
+    noFormPost => 1,
+    default    => '',
+);
+
+property country => (
+    noFormPost => 1,
+    default    => '',
+);
+
+property phoneNumber => (
+    noFormPost => 1,
+    default    => '',
+);
+
+property email => (
+    noFormPost => 1,
+    default    => '',
+);
+
+property organization => (
+    noFormPost => 1,
+    default    => '',
+);
+
+property "addressBookId" => (
+    noFormPost => 1,
+    required   => 1,
+);
+
+has [ qw/addressId addressBook/] => (
+    is => 'ro',
+    required => 1,
+);
+
+use Scalar::Util qw/blessed/;
 use WebGUI::Exception::Shop;
 
 =head1 NAME
@@ -39,166 +117,30 @@ These subroutines are available from this package:
 
 =cut
 
-readonly addressBook => my %addressBook;
-private properties => my %properties;
-
 #-------------------------------------------------------------------
 
-=head2 addressBook ( )
+=head2 new ( $book, $addressId )
 
-Returns a reference to the Address Book.
+Constructor.  Instanciates an address based upon an addressId.
 
-=cut
+=head2 new ( $book, $properties )
 
-#-------------------------------------------------------------------
+Constructor.  Builds a new, default address.
 
-=head2 create ( addressBook, address)
+=head2 new ( $properties )
 
-Constructor. Adds an address to an address book. Returns a reference to the address.
+Constructor.  Builds a new, default address book object in Moose style with default properties set by $properties. This does not
+persist them to the database automatically.  This needs to be done via $self->write.
 
-=head3 addressBook
+=head3 $addressBook
 
-A reference to a WebGUI::Shop::AddressBook object.
+A reference to an addressBook object
 
-=head3 address
+=head3 $addressId
 
-A hash reference containing the properties to set in the address.
+The unique id of an address to instanciate.
 
-=cut
-
-sub create {
-    my ($class, $book, $addressData) = @_;
-    unless (defined $book && $book->isa("WebGUI::Shop::AddressBook")) {
-        WebGUI::Error::InvalidObject->throw(expected=>"WebGUI::Shop::AddressBook", got=>(ref $book), error=>"Need an address book.", param=>$book);
-    }
-    unless (defined $addressData && ref $addressData eq "HASH") {
-        WebGUI::Error::InvalidParam->throw(param=>$addressData, error=>"Need a hash reference.");
-    }
-    my $id = $book->session->db->setRow("address","addressId", {addressId=>"new", addressBookId=>$book->getId});
-    my $address = $class->new($book, $id);
-    $address->update($addressData);
-    return $address;
-}
-
-#-------------------------------------------------------------------
-
-=head2 delete ( )
-
-Removes this address from the book.
-
-=cut
-
-sub delete {
-    my $self = shift;
-    $self->addressBook->session->db->deleteRow("address","addressId",$self->getId);
-    return undef;
-}
-
-#-------------------------------------------------------------------
-
-=head2 get ( [ property ] )
-
-Returns a duplicated hash reference of this object’s data.
-
-=head3 property
-
-Any field − returns the value of a field rather than the hash reference.
-
-=cut
-
-sub get {
-    my ($self, $name) = @_;
-    if (defined $name) {
-        return $properties{id $self}{$name};
-    }
-    my %copyOfHashRef = %{$properties{id $self}};
-    return \%copyOfHashRef;
-}
-
-#-------------------------------------------------------------------
-
-=head2 getHtmlFormatted ()
-
-Returns an HTML formatted address for display.
-
-=cut
-
-sub getHtmlFormatted {
-    my $self = shift;
-    my $address = $self->get("firstName"). " " .$self->get("lastName") . "<br />";
-    $address .= $self->get("organization") . "<br />" if ($self->get("organization") ne "");
-    $address .= $self->get("address1") . "<br />";
-    $address .= $self->get("address2") . "<br />" if ($self->get("address2") ne "");
-    $address .= $self->get("address3") . "<br />" if ($self->get("address3") ne "");
-    $address .= $self->get("city") . ", ";
-    $address .= $self->get("state") . " " if ($self->get("state") ne "");
-    $address .= $self->get("code") if ($self->get("code") ne "");
-    $address .= '<br />' . $self->get("country");
-    $address .= '<br />'.$self->get("phoneNumber") if ($self->get("phoneNumber") ne "");
-    $address .= '<br /><a href="mailto:'.$self->get("email").'">'.$self->get("email").'</a>' if ($self->get("email") ne "");
-    return $address;
-}
-
-#-------------------------------------------------------------------
-
-=head2 getId () 
-
-Returns the unique id of this item.
-
-=cut
-
-sub getId {
-    my $self = shift;
-    return $self->get("addressId");
-}
-
-
-#-------------------------------------------------------------------
-
-=head2 new ( addressBook, addressId )
-
-Constructor.  Instanciates an existing address from the database based upon addressId.
-
-=head3 addressBook
-
-A reference to a WebGUI::Shop::AdressBook object.
-
-=head3 addressId
-
-The unique id of the address to instanciate.
-
-=cut
-
-sub new {
-    my ($class, $book, $addressId) = @_;
-    unless (defined $book && $book->isa("WebGUI::Shop::AddressBook")) {
-        WebGUI::Error::InvalidObject->throw(expected=>"WebGUI::Shop::AddressBook", got=>(ref $book), error=>"Need an address book.");
-    }
-    unless (defined $addressId) {
-        WebGUI::Error::InvalidParam->throw(error=>"Need an addressId.", param=>$addressId);
-    }
-    my $address = $book->session->db->quickHashRef('select * from address where addressId=?', [$addressId]);
-    if ($address->{addressId} eq "") {
-        WebGUI::Error::ObjectNotFound->throw(error=>"Address not found.", id=>$addressId);
-    }
-    if ($address->{addressBookId} ne $book->getId) {
-        WebGUI::Error::ObjectNotFound->throw(error=>"Address not in this address book.", id=>$addressId);
-    }
-    my $self = register $class;
-    my $id        = id $self;
-    $addressBook{ $id }   = $book;
-    $properties{ $id } = $address;
-    return $self;
-}
-
-
-#-------------------------------------------------------------------
-
-=head2 update ( properties )
-
-Sets properties of the address.
-
-=head3 properties
+=head3 $properties
 
 A hash reference that contains one or more of the following:
 
@@ -254,19 +196,165 @@ An email address for this user.
 
 The organization or company that this user is a part of.
 
-=head4 addressBookId
+=cut
 
-The address book that this address belongs to.
+
+around BUILDARGS => sub {
+    my $orig  = shift;
+    my $class = shift;
+    if (ref $_[0] eq 'HASH') {
+        my $properties = $_[0];
+        my $book = $properties->{addressBook};
+        if (! (blessed $book && $book->isa('WebGUI::Shop::AddressBook')) ) {
+            WebGUI::Error::InvalidObject->throw(expected=>"WebGUI::Shop::AddressBook", got=>(ref $book), error=>"Need an address book.", param=>$book);
+        }
+        my ($addressId)              = $class->_init($book);
+        $properties->{addressId}     = $addressId;
+        $properties->{addressBookId} = $book->addressBookId;
+        $properties->{addressBook}   = $book;
+        return $class->$orig($properties);
+    }
+    my $book = shift;
+    if (! (blessed $book && $book->isa('WebGUI::Shop::AddressBook')) ) {
+        WebGUI::Error::InvalidObject->throw(expected=>"WebGUI::Shop::AddressBook", got=>(ref $book), error=>"Need an address book.", param=>$book);
+    }
+    my $argument2 = shift;
+    if (!defined $argument2) {
+        my ($addressId)              = $class->_init($book);
+        my $properties = {};
+        $properties->{addressId}     = $addressId;
+        $properties->{addressBookId} = $book->addressBookId;
+        $properties->{addressBook}   = $book;
+        return $class->$orig($properties);
+    }
+    elsif (ref $argument2 eq 'HASH') {
+        my $properties = $argument2;
+        my ($addressId)              = $class->_init($book);
+        $properties->{addressId}     = $addressId;
+        $properties->{addressBookId} = $book->addressBookId;
+        $properties->{addressBook}   = $book;
+        return $class->$orig($properties);
+    }
+    ##Look up one in the db
+    my $address = $book->session->db->quickHashRef("select * from address where addressId=?", [$argument2]);
+    if ($address->{addressId} eq "") {
+        WebGUI::Error::ObjectNotFound->throw(error=>"Address not found.", id=>$argument2);
+    }
+    if ($address->{addressBookId} ne $book->getId) {
+        WebGUI::Error::ObjectNotFound->throw(error=>"Address not in this address book.", id=>$argument2);
+    }
+    $address->{addressBook} = $book;
+    return $class->$orig($address);
+};
+
+#-------------------------------------------------------------------
+
+=head2 _init ( session )
+
+Builds a stub of object information in the database, and returns the newly created
+addressId, and the creationDate fields so the object can be initialized correctly.
 
 =cut
 
-sub update {
-    my ($self, $newProperties) = @_;
-    my $id = id $self;
-    foreach my $field (qw(addressBookId email organization address1 address2 address3 state code city label firstName lastName country phoneNumber)) {
-        $properties{$id}{$field} = (exists $newProperties->{$field}) ? $newProperties->{$field} : $properties{$id}{$field};
-    }
-    $self->addressBook->session->db->setRow("address","addressId",$properties{$id});
+sub _init {
+    my $class     = shift;
+    my $book      = shift;
+    my $session   = $book->session;
+    my $addressId = $session->id->generate;
+    $session->db->write('insert into address (addressId, addressBookId) values (?,?)', [$addressId, $book->getId]);
+    return ($addressId);
+}
+
+#-------------------------------------------------------------------
+
+=head2 addressBook ( )
+
+Returns a reference to the Address Book.
+
+=cut
+
+#-------------------------------------------------------------------
+
+=head2 create ( book )
+
+Deprecated, left as a stub for existing code.  Use L<new> instead.
+
+=head3 book
+
+A reference to an address book.
+
+=cut
+
+sub create {
+    my ($class, $book) = @_;
+    return $class->new($book);
+}
+
+#-------------------------------------------------------------------
+
+=head2 delete ( )
+
+Removes this address from the book.
+
+=cut
+
+sub delete {
+    my $self = shift;
+    $self->addressBook->session->db->deleteRow("address","addressId",$self->getId);
+    return undef;
+}
+
+#-------------------------------------------------------------------
+
+=head2 getHtmlFormatted ()
+
+Returns an HTML formatted address for display.
+
+=cut
+
+sub getHtmlFormatted {
+    my $self = shift;
+    my $address = $self->firstName. " " .$self->lastName . "<br />";
+    $address .= $self->organization . "<br />" if ($self->organization ne "");
+    $address .= $self->address1 . "<br />";
+    $address .= $self->address2 . "<br />" if ($self->address2 ne "");
+    $address .= $self->address3 . "<br />" if ($self->address3 ne "");
+    $address .= $self->city . ", ";
+    $address .= $self->state . " " if ($self->state ne "");
+    $address .= $self->code if ($self->code ne "");
+    $address .= '<br />' . $self->country;
+    $address .= '<br />'.$self->phoneNumber if ($self->phoneNumber ne "");
+    $address .= '<br /><a href="mailto:'.$self->email.'">'.$self->email.'</a>' if ($self->email ne "");
+    return $address;
+}
+
+#-------------------------------------------------------------------
+
+=head2 getId () 
+
+Returns the unique id of this item.
+
+=cut
+
+sub getId {
+    my $self = shift;
+    return $self->get("addressId");
+}
+
+
+#-------------------------------------------------------------------
+
+=head2 write ( )
+
+Store the object's properties to the db.
+
+=cut
+
+sub write {
+    my ($self) = @_;
+    my $properties = $self->get();
+    my $book = delete $properties->{addressBook};
+    $book->session->db->setRow("address","addressId",$properties);
 }
 
 

lib/WebGUI/Shop/AddressBook.pm

@@ -2,7 +2,25 @@ package WebGUI::Shop::AddressBook;
 
 use strict;
 
-use Class::InsideOut qw{ :std };
+use Moose;
+use WebGUI::Definition;
+
+property 'userId' => (
+    noFormPost => 1,
+    default    => '',
+);
+
+property 'defaultAddressId' => (
+    noFormPost => 1,
+    default    => '',
+);
+
+has [ qw/addressBookId session/] => (
+    is => 'ro',
+    required => 1,
+);
+
+
 use JSON;
 require WebGUI::Asset::Template;
 use WebGUI::Exception::Shop;
@@ -31,9 +49,103 @@ These subroutines are available from this package:
 
 =cut
 
-readonly session => my %session;
-private properties => my %properties;
-private addressCache => my %addressCache;
+#-------------------------------------------------------------------
+
+=head2 new ( $session, $addressBookId )
+
+Constructor.  Instanciates an address book based upon an addressBookId.
+
+=head2 new ( $session )
+
+Constructor.  Builds a new, default address book object.
+
+=head2 new ( $properties )
+
+Constructor.  Builds a new, default address book object in Moose style with default properties set by $properties. This does not
+persist them to the database automatically.  This needs to be done via $self->write.
+
+=head3 $session
+
+A reference to the current session.
+
+=head3 $addressBookId
+
+The unique id of a cart to instanciate.
+
+=head3 $properties
+
+A hash reference that contains one or more of the following:
+
+=head4 defaultAddressId
+
+The unique id for a address attached to this cart.
+
+=head4 userId
+
+The unique id for the user who owns this cart.
+
+=cut
+
+
+around BUILDARGS => sub {
+    my $orig  = shift;
+    my $class = shift;
+    if (ref $_[0] eq 'HASH') {
+        my $properties = $_[0];
+        my $session = $properties->{session};
+        if (! (blessed $session && $session->isa('WebGUI::Session')) ) {
+            WebGUI::Error::InvalidObject->throw(expected=>"WebGUI::Session", got=>(ref $session), error=>"Need a session.");
+        }
+        if ($session->user->isVisitor) {
+            WebGUI::Error::InvalidParam->throw(error=>"Visitor cannot have an address book.");
+        }
+        my ($addressBookId)          = $class->_init($session);
+        $properties->{addressBookId} = $addressBookId;
+        $properties->{userId}        = $session->user->userId;
+        return $class->$orig($properties);
+    }
+    my $session = shift;
+    if (! (blessed $session && $session->isa('WebGUI::Session'))) {
+        WebGUI::Error::InvalidObject->throw(expected=>"WebGUI::Session", got=>(ref $session), error=>"Need a session.");
+    }
+    if ($session->user->isVisitor) {
+        WebGUI::Error::InvalidParam->throw(error=>"Visitor cannot have an address book.");
+    }
+    my $argument2 = shift;
+    if (!defined $argument2) {
+        my ($addressBookId)          = $class->_init($session);
+        my $properties = {};
+        $properties->{session}       = $session;
+        $properties->{addressBookId} = $addressBookId;
+        $properties->{userId}        = $session->user->userId;
+        return $class->$orig($properties);
+    }
+    ##Look up one in the db
+    my $book = $session->db->quickHashRef("select * from addressBook where addressBookId=?", [$argument2]);
+    if ($book->{addressBookId} eq "") {
+        WebGUI::Error::ObjectNotFound->throw(error=>"No such address book.", id=>$argument2);
+    }
+    $book->{session} = $session;
+    return $class->$orig($book);
+};
+
+#-------------------------------------------------------------------
+
+=head2 _init ( session )
+
+Builds a stub of object information in the database, and returns the newly created
+addressBookId, and the creationDate fields so the object can be initialized correctly.
+
+=cut
+
+sub _init {
+    my $class          = shift;
+    my $session        = shift;
+    my $addressBookId  = $session->id->generate;
+    $session->db->write('insert into addressBook (addressBookId, userId) values (?,?)', [$addressBookId, $session->user->userId]);
+    return ($addressBookId);
+}
+
 
 #-------------------------------------------------------------------
 
@@ -51,7 +163,8 @@ A hash reference containing address information.
 
 sub addAddress {
     my ($self, $address) = @_;
-    my $addressObj = WebGUI::Shop::Address->create( $self, $address);
+    my $addressObj = WebGUI::Shop::Address->create($self);
+    $addressObj->update($address);
     return $addressObj;
 }
 
@@ -114,32 +227,19 @@ sub appendAddressFormVars {
 
 #-------------------------------------------------------------------
 
-=head2 create ( session, userId )
+=head2 create ( session )
 
-Constructor. Creates a new address book for this user.
+Deprecated, left as a stub for existing code.  Use L<new> instead.
 
 =head3 session
 
 A reference to the current session.
 
-=head3 userId
-
-The userId for the user.  Throws an exception if it is Visitor.  Defaults to the session
-user if omitted.
-
 =cut
 
 sub create {
-    my ($class, $session, $userId) = @_;
-    unless (defined $session && $session->isa("WebGUI::Session")) {
-        WebGUI::Error::InvalidObject->throw(expected=>"WebGUI::Session", got=>(ref $session), error=>"Need a session.");
-    }
-    $userId ||= $session->user->userId;
-    if ($userId eq '1') {
-        WebGUI::Error::InvalidParam->throw(error=>"Visitor cannot have an address book.");
-    }
-    my $id = $session->db->setRow("addressBook", "addressBookId", {addressBookId=>"new", userId=>$userId}); 
-    return $class->new($session, $id);
+    my ($class, $session) = @_;
+    return $class->new($session);
 }
 
 #-------------------------------------------------------------------
@@ -152,9 +252,7 @@ Deletes this address book and all addresses contained in it.
 
 sub delete {
     my ($self) = @_;
-    my $myId   = id $self;
     foreach my $address (@{$self->getAddresses}) {
-        delete $addressCache{$myId}{$address->getId};
         $address->delete;
     } 
     $self->session->db->write("delete from addressBook where addressBookId=?",[$self->getId]);
@@ -181,28 +279,6 @@ sub formatCallbackForm {
 
 #-------------------------------------------------------------------
 
-=head2 get ( [ property ] )
-
-Returns a duplicated hash reference of this object’s data.
-
-=head3 property
-
-Any field − returns the value of a field rather than the hash reference.  See the 
-C<update> method.
-
-=cut
-
-sub get {
-    my ($self, $name) = @_;
-    if (defined $name) {
-        return $properties{id $self}{$name};
-    }
-    my %copyOfHashRef = %{$properties{id $self}};
-    return \%copyOfHashRef;
-}
-
-#-------------------------------------------------------------------
-
 =head2 getAddress ( id )
 
 Returns an address object.
@@ -215,11 +291,10 @@ An address object's unique id.
 
 sub getAddress {
     my ($self, $addressId) = @_;
-    my $id = id $self;
-    unless (exists $addressCache{$id}{$addressId}) {
-        $addressCache{$id}{$addressId} = WebGUI::Shop::Address->new($self, $addressId);
+    unless (exists $self->{_addressCache}->{$addressId}) {
+        $self->{_addressCache}->{$addressId} = WebGUI::Shop::Address->new($self, $addressId);
     }
-    return $addressCache{$id}{$addressId};
+    return $self->{_addressCache}->{$addressId};
 }
 
 #-------------------------------------------------------------------
@@ -337,41 +412,6 @@ sub missingFields {
 
 #-------------------------------------------------------------------
 
-=head2 new ( session, addressBookId )
-
-Constructor.  Instanciates an addressBook based upon a addressBookId.
-
-=head3 session
-
-A reference to the current session.
-
-=head3 addressBookId
-
-The unique id of an address book to instanciate.
-
-=cut
-
-sub new {
-    my ($class, $session, $addressBookId) = @_;
-    unless (defined $session && $session->isa("WebGUI::Session")) {
-        WebGUI::Error::InvalidObject->throw(expected=>"WebGUI::Session", got=>(ref $session), error=>"Need a session.");
-    }
-    unless (defined $addressBookId) {
-        WebGUI::Error::InvalidParam->throw(error=>"Need an addressBookId.");
-    }
-    my $addressBook = $session->db->quickHashRef('select * from addressBook where addressBookId=?', [$addressBookId]);
-    if ($addressBook->{addressBookId} eq "") {
-        WebGUI::Error::ObjectNotFound->throw(error=>"No such address book.", id=>$addressBookId);
-    }
-    my $self = register $class;
-    my $id        = id $self;
-    $session{ $id }   = $session;
-    $properties{ $id } = $addressBook;
-    return $self;
-}
-
-#-------------------------------------------------------------------
-
 =head2 newByUserId ( session, userId )
 
 Constructor. Creates a new address book for this user if they don't have one.  In any case returns a reference to the address book.
@@ -418,7 +458,7 @@ sub newByUserId {
     }
     else {
         # nope create one for the user
-        return $class->create($session);
+        return $class->new($session);
     }
 }
 
@@ -465,31 +505,15 @@ sub processAddressForm {
 
 #-------------------------------------------------------------------
 
-=head2 update ( properties )
+=head2 write ( )
 
-Sets properties in the addressBook
-
-=head3 properties
-
-A hash reference that contains one of the following:
-
-=head4 userId
-
-Assign the user that owns this address book.
-
-=head4 defaultAddressId
-
-The id of the address to be made the default for this address book.
+Writes the object properties to the database.
 
 =cut
 
-sub update {
+sub write {
     my ($self, $newProperties) = @_;
-    my $id = id $self;
-    foreach my $field (qw(userId defaultAddressId)) {
-        $properties{$id}{$field} = (exists $newProperties->{$field}) ? $newProperties->{$field} : $properties{$id}{$field};
-    }
-    $self->session->db->setRow("addressBook","addressBookId",$properties{$id});
+    $self->session->db->setRow("addressBook","addressBookId",$self->get());
 }
 
 #-------------------------------------------------------------------

lib/WebGUI/Shop/Admin.pm

@@ -1,7 +1,27 @@
 package WebGUI::Shop::Admin;
 
 use strict;
-use Class::InsideOut qw{ :std };
+
+use Moose;
+
+has session => (
+    is              => 'ro',
+    required        => 1,
+);
+
+around BUILDARGS => sub {
+    my $orig       = shift;
+    my $className  = shift;
+
+    ##Original arguments start here.
+    my $protoSession = $_[0];
+    if (blessed $protoSession && $protoSession->isa('WebGUI::Session')) {
+        return $className->$orig(session => $protoSession);
+    }
+    return $className->$orig(@_);
+};
+
+
 use WebGUI::AdminConsole;
 use WebGUI::Exception::Shop;
 use WebGUI::HTMLForm;
@@ -28,8 +48,6 @@ These subroutines are available from this package:
 
 =cut
 
-readonly session => my %session;
-
 #-------------------------------------------------------------------
 
 =head2 canManage ( [ $user ] )
@@ -103,17 +121,6 @@ A reference to the current session.
 
 =cut
 
-sub new {
-    my ($class, $session) = @_;
-    unless (defined $session && $session->isa("WebGUI::Session")) {
-        WebGUI::Error::InvalidObject->throw(expected=>"WebGUI::Session", got=>(ref $session), error=>"Need a session.");
-    }
-    my $self = register $class;
-    my $id        = id $self;
-    $session{ $id } = $session;
-    return $self;
-}
-
 #-------------------------------------------------------------------
 
 =head2 session () 

lib/WebGUI/Shop/Cart.pm

@@ -2,7 +2,58 @@ package WebGUI::Shop::Cart;
 
 use strict;
 
-use Class::InsideOut qw{ :std };
+use Scalar::Util qw/blessed/;
+use Moose;
+use WebGUI::Definition;
+
+property 'shippingAddressId' => (
+    noFormPost => 1,
+    default    => '',
+);
+
+property 'billingAddressId' => (
+    noFormPost => 1,
+    default    => '',
+);
+
+property 'shipperId' => (
+    noFormPost => 1,
+    default    => '',
+);
+
+property 'gatewayId' => (
+    noFormPost => 1,
+    default    => '',
+);
+
+property 'posUserId' => (
+    noFormPost => 1,
+    default    => '',
+);
+
+property creationDate => (
+    required   => 1,
+    noFormPost => 1,
+    default    => '',
+);
+has [ qw/cartId session/] => (
+    is => 'ro',
+    required => 1,
+);
+has sessionId => (
+    is => 'ro',
+    lazy => 1,
+    builder => '_default_sessionId',
+);
+sub _default_sessionId {
+    my $self = shift;
+    return $self->session->getId;
+}
+has error => (
+    is       => 'rw',
+);
+
+
 use JSON;
 use WebGUI::Asset::Template;
 use WebGUI::Exception::Shop;
@@ -38,10 +89,110 @@ These subroutines are available from this package:
 
 =cut
 
-readonly session => my %session;
-private properties => my %properties;
-public error => my %error;
-private addressBookCache => my %addressBookCache;
+#-------------------------------------------------------------------
+
+=head2 new ( $session, $cartId )
+
+Constructor.  Instanciates a cart based upon a cartId.
+
+=head2 new ( $session )
+
+Constructor.  Builds a new, default cart object.
+
+=head2 new ( $properties )
+
+Constructor.  Builds a new, default cart object in Moose style with default properties set by $properties. This does not
+persist them to the database automatically.  This needs to be done via $self->write.
+
+=head3 $session
+
+A reference to the current session.
+
+=head3 $cartId
+
+The unique id of a cart to instanciate.
+
+=head3 $properties
+
+A hash reference that contains one or more of the following:
+
+=head4 shippingAddressId
+
+The unique id for a shipping address attached to this cart.
+
+=head4 billingAddressId
+
+The unique id for a billing address attached to this cart.
+
+=head4 shipperId
+
+The unique id of the configured shipping driver that will be used to ship these goods.
+
+=head4 posUserId
+
+The ID of a user being checked out, if they're being checked out by a cashier.
+
+=head4 creationDate
+
+The date the cart was created.
+
+=cut
+
+
+around BUILDARGS => sub {
+    my $orig  = shift;
+    my $class = shift;
+    if (ref $_[0] eq 'HASH') {
+        my $properties = $_[0];
+        my $session = $properties->{session};
+        if (! (blessed $session && $session->isa('WebGUI::Session')) ) {
+            WebGUI::Error::InvalidObject->throw(expected=>"WebGUI::Session", got=>(ref $session), error=>"Need a session.");
+        }
+        my ($cartId, $creationDate) = $class->_init($session);
+        $properties->{cartId}       = $cartId;
+        $properties->{creationDate} = $creationDate;
+        return $class->$orig($properties);
+    }
+    my $session = shift;
+    if (! (blessed $session && $session->isa('WebGUI::Session'))) {
+        WebGUI::Error::InvalidObject->throw(expected=>"WebGUI::Session", got=>(ref $session), error=>"Need a session.");
+    }
+    my $argument2 = shift;
+    if (!defined $argument2) {
+        my ($cartId, $creationDate) = $class->_init($session);
+        my $properties = {};
+        $properties->{session}      = $session;
+        $properties->{cartId}       = $cartId;
+        $properties->{creationDate} = $creationDate;
+        return $class->$orig($properties);
+    }
+    ##Look up one in the db
+    my $cart = $session->db->quickHashRef("select * from cart where cartId=?", [$argument2]);
+    if ($cart->{cartId} eq "") {
+        WebGUI::Error::ObjectNotFound->throw(error=>"No such cart.", id=>$argument2);
+    }
+    $cart->{session} = $session;
+    return $class->$orig($cart);
+};
+
+
+#-------------------------------------------------------------------
+
+=head2 _init ( session )
+
+Builds a stub of object information in the database, and returns the newly created
+cartId, and the creationDate fields so the object can be initialized correctly.
+
+=cut
+
+sub _init {
+    my $class        = shift;
+    my $session      = shift;
+    my $creationDate = WebGUI::DateTime->new($session)->epoch;
+    my $cartId       = $session->id->generate;
+    $session->db->write('insert into cart (cartId, sessionId, creationDate) values (?,?,?)', [$cartId, $session->getId, $creationDate]);
+    return ($cartId, $creationDate);
+}
 
 #-------------------------------------------------------------------
 
@@ -83,7 +234,7 @@ sub calculateShopCreditDeduction {
     }
     # cannot use in-shop credit on recurring items
     return $self->formatCurrency(0) if $self->requiresRecurringPayment;
-    return $self->formatCurrency(WebGUI::Shop::Credit->new($self->session, $self->get('posUserId'))->calculateDeduction($total));
+    return $self->formatCurrency(WebGUI::Shop::Credit->new($self->session, $self->posUserId)->calculateDeduction($total));
 }
 
 #-------------------------------------------------------------------
@@ -160,7 +311,7 @@ sub calculateTotal {
 
 =head2 create ( session )
 
-Constructor. Creates a new cart object if there’s not one already attached to the current session object. Otherwise just instanciates the existing one.  Returns a reference to the object.
+Deprecated, left as a stub for existing code.  Use L<new> instead.
 
 =head3 session
 
@@ -170,12 +321,7 @@ A reference to the current session.
 
 sub create {
     my ($class, $session) = @_;
-    unless (defined $session && $session->isa("WebGUI::Session")) {
-        WebGUI::Error::InvalidObject->throw(expected=>"WebGUI::Session", got=>(ref $session), error=>"Need a session.");
-    }
-    my $cartId = $session->id->generate;
-    $session->db->write('insert into cart (cartId, sessionId, creationDate) values (?,?,UNIX_TIMESTAMP())', [$cartId, $session->getId]);
-    return $class->new($session, $cartId);
+    return $class->new($session);
 }
 
 #-------------------------------------------------------------------
@@ -230,27 +376,6 @@ sub formatCurrency {
 
 #-------------------------------------------------------------------
 
-=head2 get ( [ property ] )
-
-Returns a duplicated hash reference of this object’s data.
-
-=head3 property
-
-Any field − returns the value of a field rather than the hash reference.
-
-=cut
-
-sub get {
-    my ($self, $name) = @_;
-    if (defined $name) {
-        return $properties{id $self}{$name};
-    }
-    my %copyOfHashRef = %{$properties{id $self}};
-    return \%copyOfHashRef;
-}
-
-#-------------------------------------------------------------------
-
 =head2 getAddressBook ()
 
 Returns a reference to the address book for the user who's cart this is.
@@ -259,11 +384,10 @@ Returns a reference to the address book for the user who's cart this is.
 
 sub getAddressBook {
     my $self = shift;
-    my $id = id $self;
-    unless (exists $addressBookCache{$id}) {
-        $addressBookCache{$id} = WebGUI::Shop::AddressBook->newByUserId($self->session);
+    unless (exists $self->{_addressBook}) {
+        $self->{_addressBook} = WebGUI::Shop::AddressBook->newByUserId($self->session);
     }    
-    return $addressBookCache{$id};
+    return $self->{_addressBook};
 }
 
 #-------------------------------------------------------------------
@@ -277,7 +401,7 @@ Returns the WebGUI::Shop::Address object that is attached to this cart for billi
 sub getBillingAddress {
     my $self = shift;
     my $book = $self->getAddressBook;
-    if (my $addressId = $self->get("billingAddressId")) {
+    if (my $addressId = $self->billingAddressId) {
         return $book->getAddress($addressId);
     }
     my $address = $book->getDefaultAddress;
@@ -332,7 +456,7 @@ Returns the unique id for this cart.
 
 sub getId {
     my ($self) = @_;
-    return $self->get("cartId");
+    return $self->cartId;
 }
 
 #-------------------------------------------------------------------
@@ -409,7 +533,7 @@ Returns the WebGUI::Shop::PayDriver object that is attached to this cart for pay
 
 sub getPaymentGateway {
     my $self = shift;
-    return WebGUI::Shop::Pay->new($self->session)->getPaymentGateway($self->get("gatewayId"));
+    return WebGUI::Shop::Pay->new($self->session)->getPaymentGateway($self->gatewayId);
 }
 
 #-------------------------------------------------------------------
@@ -422,7 +546,7 @@ Returns the userId of the user making a purchase. If there is a cashier and the
 
 sub getPosUser {
     my $self = shift;
-    if ($self->get('posUserId') ne "") {
+    if ($self->posUserId ne "") {
         return WebGUI::User->new($self->session, $self->get('posUserId'));
     }
     return $self->session->user;    
@@ -438,7 +562,7 @@ Returns the WebGUI::Shop::ShipDriver object that is attached to this cart for sh
 
 sub getShipper {
     my $self = shift;
-    return WebGUI::Shop::Ship->new(session => $self->session)->getShipper($self->get("shipperId"));
+    return WebGUI::Shop::Ship->new(session => $self->session)->getShipper($self->shipperId);
 }
 
 #-------------------------------------------------------------------
@@ -452,8 +576,8 @@ Returns the WebGUI::Shop::Address object that is attached to this cart for shipp
 sub getShippingAddress {
     my $self = shift;
     my $book = $self->getAddressBook;
-    if ($self->get("shippingAddressId")) {
-        return $book->getAddress($self->get("shippingAddressId"));
+    if ($self->shippingAddressId) {
+        return $book->getAddress($self->shippingAddressId);
     }
     my $address = $book->getDefaultAddress;
     $self->update({shippingAddressId=>$address->getId});
@@ -487,41 +611,6 @@ sub hasMixedItems {
 
 #-------------------------------------------------------------------
 
-=head2 new ( session, cartId )
-
-Constructor.  Instanciates a cart based upon a cartId.
-
-=head3 session
-
-A reference to the current session.
-
-=head3 cartId
-
-The unique id of a cart to instanciate.
-
-=cut
-
-sub new {
-    my ($class, $session, $cartId) = @_;
-    unless (defined $session && $session->isa("WebGUI::Session")) {
-        WebGUI::Error::InvalidObject->throw(expected=>"WebGUI::Session", got=>(ref $session), error=>"Need a session.");
-    }
-    unless (defined $cartId && $cartId =~ m/^[A-Za-z0-9_-]{22}$/) {
-        WebGUI::Error::InvalidParam->throw(error=>"Need a cartId.");
-    }
-    my $cart = $session->db->quickHashRef('select * from cart where cartId=?', [$cartId]);
-    if ($cart->{cartId} eq "") {
-        WebGUI::Error::ObjectNotFound->throw(error=>"No such cart.", id=>$cartId);
-    }
-    my $self = register $class;
-    my $id        = id $self;
-    $session{ $id }   = $session;
-    $properties{ $id } = $cart;
-    return $self;
-}
-
-#-------------------------------------------------------------------
-
 =head2 newBySession ( session )
 
 Class method that figures out if the user has a cart in their session. If they do it returns it. If they don't it creates it and returns it.
@@ -538,8 +627,7 @@ sub newBySession {
         WebGUI::Error::InvalidObject->throw(expected=>"WebGUI::Session", got=>(ref $session), error=>"Need a session.");
     }
     my $cartId = $session->db->quickScalar("select cartId from cart where sessionId=?",[$session->getId]);
-    return $class->new($session, $cartId) if (defined $cartId and $cartId ne '');
-    return $class->create($session);
+    return $class->new($session, $cartId);  ##Falls back to creating a new cart if there's no 2nd argument
 }
 
 #-------------------------------------------------------------------
@@ -597,12 +685,12 @@ sub readyForCheckout {
 
     if ($self->requiresShipping) {
         ##Must have a configured shipping id.
-        if (! $self->get('shipperId')) {
+        if (! $self->shipperId) {
             $self->error('no shipping method set');
             return 0;
         }
 
-        my $shipper = eval { WebGUI::Shop::ShipDriver->new($session, $self->get('shipperId'))};
+        my $shipper = eval { WebGUI::Shop::ShipDriver->new($session, $self->shipperId)};
         if (my $e = WebGUI::Error->caught) {
             $self->error($e->error);
             return 0;
@@ -628,19 +716,19 @@ sub readyForCheckout {
     }
 
     ##Must have a configured payment method.
-    if (! $self->get('gatewayId')) {
+    if (! $self->gatewayId) {
         $self->error('no payment gateway set');
         return 0;
     }
 
-    my $gateway = eval { WebGUI::Shop::PayDriver->new($session, $self->get('gatewayId'))};
+    my $gateway = eval { WebGUI::Shop::PayDriver->new($session, $self->gatewayId)};
     if (my $e = WebGUI::Error->caught) {
         $self->error($e->error);
         return 0;
     }
 
     ##Check for any other logged errors
-    return 0 if $error{ id $self };
+    return 0 if $self->error;
 
     # All checks passed so return true
     return 1;
@@ -688,46 +776,17 @@ sub requiresShipping {
 
 #-------------------------------------------------------------------
 
-=head2 update ( properties )
+=head2 write ( )
 
-Sets properties in the cart.
-
-=head3 properties
-
-A hash reference that contains one of the following:
-
-=head4 shippingAddressId
-
-The unique id for a shipping address attached to this cart.
-
-=head4 billingAddressId
-
-The unique id for a billing address attached to this cart.
-
-=head4 shipperId
-
-The unique id of the configured shipping driver that will be used to ship these goods.
-
-=head4 posUserId
-
-The ID of a user being checked out, if they're being checked out by a cashier.
-
-=head4 creationDate
-
-The date the cart was created.
+Serialize the current set of cart properties to the database.
 
 =cut
 
-sub update {
-    my ($self, $newProperties) = @_;
-    unless (defined $newProperties && ref $newProperties eq 'HASH') {
-        WebGUI::Error::InvalidParam->throw(error=>"Need a properties hash ref.");
-    }
-    my $id = id $self;
-    foreach my $field (qw(billingAddressId shippingAddressId posUserId gatewayId shipperId creationDate)) {
-        $properties{$id}{$field} = (exists $newProperties->{$field}) ? $newProperties->{$field} : $properties{$id}{$field};
-    }
-    $self->session->db->setRow("cart","cartId",$properties{$id});
+sub write {
+    my ($self)     = @_;
+    my $properties = $self->get();
+    delete $properties->{error};
+    $self->session->db->setRow("cart", "cartId", $properties);
 }
 
 #-------------------------------------------------------------------
@@ -747,10 +806,10 @@ sub updateFromForm {
             eval { $item->setQuantity($form->get("quantity-".$item->getId)) };
             if (WebGUI::Error->caught("WebGUI::Error::Shop::MaxOfItemInCartReached")) {
                 my $i18n = WebGUI::International->new($self->session, "Shop");
-                $error{id $self} = sprintf($i18n->get("too many of this item"), $item->get("configuredTitle"));
+                $self->error(sprintf($i18n->get("too many of this item"), $item->get("configuredTitle")));
             }
             elsif (my $e = WebGUI::Error->caught) {
-                $error{id $self} = "An unknown error has occured: ".$e->message;
+                $self->error("An unknown error has occured: ".$e->message);
             }
         }
         if (my $itemAddressId = $form->get("itemAddress_".$item->getId)) {
@@ -759,7 +818,7 @@ sub updateFromForm {
     }
     if ($self->hasMixedItems) {
          my $i18n = WebGUI::International->new($self->session, "Shop");
-        $error{id $self} = $i18n->get('mixed items warning');
+        $self->error($i18n->get('mixed items warning'));
     }
 
     my @cartItemIds = $form->process('remove_item', 'checkList');
@@ -782,7 +841,7 @@ sub updateFromForm {
         my $newAddress = $book->addAddress(\%billingData);
         $cartProperties->{billingAddressId} = $newAddress->get('addressId');
     }
-    elsif ($billingAddressId eq 'update_address' && $self->get('billingAddressId') && ! @missingBillingFields) {
+    elsif ($billingAddressId eq 'update_address' && $self->billingAddressId && ! @missingBillingFields) {
         ##User updated the current address
         my $address = $self->getBillingAddress();
         $address->update(\%billingData);
@@ -802,7 +861,7 @@ sub updateFromForm {
 
     if ($self->requiresShipping) {
         if ($form->process('sameShippingAsBilling', 'yesNo')) {
-            $cartProperties->{shippingAddressId} = $self->get('billingAddressId');
+            $cartProperties->{shippingAddressId} = $self->billingAddressId;
         }
         else {
             my %shippingData = $book->processAddressForm('shipping_');
@@ -817,7 +876,7 @@ sub updateFromForm {
                 my $newAddress = $book->addAddress(\%shippingData);
                 $cartProperties->{shippingAddressId} = $newAddress->get('addressId');
             }
-            elsif ($shippingAddressId eq 'update_address' && $self->get('shippingAddressId') && ! @missingShippingFields) {
+            elsif ($shippingAddressId eq 'update_address' && $self->shippingAddressId && ! @missingShippingFields) {
                 ##User changed the address selector
                 my $address = $self->getBillingAddress();
                 $address->update(\%shippingData);
@@ -918,8 +977,8 @@ sub www_checkout {
     my $self    = shift;
     my $session = $self->session;
     ##Setting a shipping address greatly simplifies the Transaction
-    if (! $self->requiresShipping && ! $self->get('shippingAddressId')) {
-        $self->update({shippingAddressId => $self->get('billingAddressId')});
+    if (! $self->requiresShipping && ! $self->shippingAddressId) {
+        $self->update({shippingAddressId => $self->billingAddressId});
     }
     if ($self->readyForCheckout()) {
         my $total = $self->calculateTotal;
@@ -1049,7 +1108,7 @@ sub www_view {
 
     # get the shipping address    
     my $address = eval { $self->getShippingAddress };
-    if (my $e = WebGUI::Error->caught("WebGUI::Error::ObjectNotFound") && $self->get('shippingAddressId')) {
+    if (my $e = WebGUI::Error->caught("WebGUI::Error::ObjectNotFound") && $self->shippingAddressId) {
         # choose another address cuz we've got a problem
         $self->update({shippingAddressId=>''});
     }
@@ -1125,7 +1184,7 @@ sub www_view {
                     $formOptions{$optionId} .= ' ('.$self->formatCurrency($options->{$optionId}{price}).')';
                 }
             }
-            my $shipperId = $self->get('shipperId');
+            my $shipperId = $self->shipperId;
             if (!$shipperId && $numberOfOptions == 1) {
                 my ($option) = keys %{ $options };
                 $self->update({shipperId => $option});
@@ -1172,7 +1231,7 @@ sub www_view {
         tie my %billingAddressOptions, 'Tie::IxHash';
         $billingAddressOptions{'new_address'} = $i18n->get('Add new address');
 
-        my $billingAddressId = $self->get('billingAddressId');
+        my $billingAddressId = $self->billingAddressId;
         if ($billingAddressId) {
             $billingAddressOptions{'update_address'} = sprintf $i18n->get('Update %s'), $self->getBillingAddress->get('label');
         }
@@ -1188,7 +1247,7 @@ sub www_view {
         tie my %shippingAddressOptions, 'Tie::IxHash';
         $shippingAddressOptions{'new_address'} = $i18n->get('Add new address');
 
-        my $shippingAddressId = $self->get('shippingAddressId');
+        my $shippingAddressId = $self->shippingAddressId;
         if ($shippingAddressId) {
             $shippingAddressOptions{'update_address'} = sprintf $i18n->get('Update %s'), $self->getShippingAddress->get('label');
         }
@@ -1200,15 +1259,15 @@ sub www_view {
             value   => $shippingAddressId ? $shippingAddressId : 'new_address',
         });
 
-        my $shippingAddressData = $self->get('shippingAddressId') ? $self->getShippingAddress->get() : {};
-        my $billingAddressData  = $self->get('billingAddressId')  ? $self->getBillingAddress->get()  : {};
+        my $shippingAddressData = $self->shippingAddressId ? $self->getShippingAddress->get() : {};
+        my $billingAddressData  = $self->billingAddressId  ? $self->getBillingAddress->get()  : {};
         my $addressBook = $self->getAddressBook;
         $addressBook->appendAddressFormVars(\%var, 'shipping_', $shippingAddressData);
         $addressBook->appendAddressFormVars(\%var, 'billing_',  $billingAddressData);
 
         $var{sameShippingAsBilling} = WebGUI::Form::yesNo($session, {
             name => 'sameShippingAsBilling',
-            value => $self->get('billingAddressId') && $self->get('billingAddressId') eq $self->get('shippingAddressId'),
+            value => $self->billingAddressId && $self->billingAddressId eq $self->shippingAddressId,
         });
     }
 
@@ -1223,7 +1282,7 @@ sub www_view {
     $var{paymentOptions} = WebGUI::Form::selectBox($session, {
         name    => 'gatewayId',
         options => \%paymentOptions,
-        value   => $self->get('gatewayId') || $form->get('gatewayId') || '',
+        value   => $self->gatewayId || $form->get('gatewayId') || '',
     });
 
     # POS variables

lib/WebGUI/Shop/Credit.pm

@@ -1,7 +1,15 @@
 package WebGUI::Shop::Credit;
 
 use strict;
-use Class::InsideOut qw{ :std };
+use Moose;
+use Scalar::Util qw/blessed/;
+
+has [ qw/session userId/ ] => (
+    is       => 'ro',
+    required => 1,
+);
+
+
 use WebGUI::Shop::Admin;
 use WebGUI::Exception::Shop;
 use WebGUI::International;
@@ -28,8 +36,18 @@ These subroutines are available from this package:
 
 =cut
 
-readonly session => my %session;
-readonly userId => my %userId;
+around BUILDARGS => sub {
+    my $orig       = shift;
+    my $className  = shift;
+
+    ##Original arguments start here.
+    my $protoSession = $_[0];
+    if (blessed $protoSession && $protoSession->isa('WebGUI::Session')) {
+        return $className->$orig(session => $protoSession, userId => $_[1], );
+    }
+    return $className->$orig(@_);
+};
+
 
 #-------------------------------------------------------------------
 
@@ -137,21 +155,6 @@ A unique id for a user that you want to adjust the credit of. Defaults to the cu
 
 =cut
 
-sub new {
-    my ($class, $session, $userId) = @_;
-    unless (defined $session && $session->isa("WebGUI::Session")) {
-        WebGUI::Error::InvalidObject->throw(expected=>"WebGUI::Session", got=>(ref $session), error=>"Need a session.");
-    }
-    unless (defined $userId) {
-        $userId = $session->user->userId;
-    }
-    my $self = register $class;
-    my $id        = id $self;
-    $session{ $id } = $session;
-    $userId{ $id } = $userId;
-    return $self;
-}
-
 #-------------------------------------------------------------------
 
 =head2 session () 

lib/WebGUI/Shop/Pay.pm

@@ -16,7 +16,6 @@ package WebGUI::Shop::Pay;
 
 use strict;
 
-#use Class::InsideOut qw{ :std };
 use Moose;
 use WebGUI::Exception;
 use WebGUI::International;

lib/WebGUI/Shop/Vendor.pm

@@ -1,7 +1,93 @@
 package WebGUI::Shop::Vendor;
 
 use strict;
-use Class::InsideOut qw{ :std };
+use Scalar::Util qw/blessed/;
+use Moose;
+use WebGUI::Definition;
+
+property 'name' => (
+    is         => 'rw',
+    noFormPost => 1,
+    default    => '',
+);
+
+property 'userId' => (
+    is         => 'rw',
+    noFormPost => 1,
+    default    => '',
+);
+
+property 'url' => (
+    is         => 'rw',
+    noFormPost => 1,
+    default    => '',
+);
+
+property 'paymentInformation' => (
+    is         => 'rw',
+    noFormPost => 1,
+    default    => '',
+);
+
+property 'preferredPaymentType' => (
+    is         => 'rw',
+    noFormPost => 1,
+    default    => '',
+);
+
+has 'dateCreated' => (
+    is => 'ro',
+);
+has [ qw/session vendorId/ ] => (
+    is       => 'ro',
+    required => 1,
+);
+
+around BUILDARGS => sub {
+    my $orig  = shift;
+    my $class = shift;
+    if (ref $_[0] eq 'HASH') {
+        ##Need same db code as below here.
+        ##Session check goes here?
+        ##Build a new one
+        my $properties = $_[0];
+        my $session = $properties->{session};
+        if (! (blessed $session && $session->isa('WebGUI::Session')) ) {
+            WebGUI::Error::InvalidObject->throw(expected=>"WebGUI::Session", got=>(ref $session), error=>"Need a session.");
+        }
+        my ($vendorId, $dateCreated) = $class->_init($session);
+        $properties->{vendorId}    = $vendorId;
+        $properties->{dateCreated} = $dateCreated;
+        return $class->$orig($properties);
+    }
+    my $session = shift;
+    if (! (blessed $session && $session->isa('WebGUI::Session'))) {
+        WebGUI::Error::InvalidObject->throw(expected=>"WebGUI::Session", got=>(ref $session), error=>"Need a session.");
+    }
+    my $argument2 = shift;
+    if (!defined $argument2) {
+        WebGUI::Error::InvalidParam->throw( param=>$argument2, error=>"Need a vendorId.");
+    }
+    if (ref $argument2 eq 'HASH') {
+        ##Build a new one
+        my ($vendorId, $dateCreated) = $class->_init($session);
+        my $properties             = $argument2;
+        $properties->{session}     = $session;
+        $properties->{vendorId}    = $vendorId;
+        $properties->{dateCreated} = $dateCreated;
+        return $class->$orig($properties);
+    }
+    else {
+        ##Look up one in the db
+        my $vendor = $session->db->quickHashRef("select * from vendor where vendorId=?", [$argument2]);
+        if ($vendor->{vendorId} eq "") {
+            WebGUI::Error::ObjectNotFound->throw(error=>"Vendor not found.", id=>$argument2);
+        }
+        $vendor->{session} = $session;
+        return $class->$orig($vendor);
+    }
+};
+
 use WebGUI::Shop::Admin;
 use WebGUI::Exception::Shop;
 use WebGUI::International;
@@ -21,7 +107,7 @@ Keeps track of vendors that sell merchandise in the store.
 
  use WebGUI::Shop::Vendor;
 
- my $vendor = WebGUI::Shop::Vendor->new($session, $vendord);
+ my $vendor = WebGUI::Shop::Vendor->new($session, $vendorId);
 
 =head1 METHODS
 
@@ -29,35 +115,35 @@ These subroutines are available from this package:
 
 =cut
 
-readonly session => my %session;
-readonly properties => my %properties;
+#-------------------------------------------------------------------
+
+=head2 _init ( session )
+
+Builds a stub of object information in the database, and returns the newly created
+vendorId, and the dateCreated fields so the object can be initialized correctly.
+
+=cut
+
+sub _init {
+    my $class       = shift;
+    my $session     = shift;
+    my $vendorId    = $session->id->generate;
+    my $dateCreated = WebGUI::DateTime->new($session)->toDatabase;
+    $session->db->write("insert into vendor (vendorId, dateCreated) values (?, ?)",[$vendorId, $dateCreated]);
+    return ($vendorId, $dateCreated);
+}
 
 #-------------------------------------------------------------------
 
 =head2 create ( session, properties )
 
-Constructor. Creates a new vendor.
-
-=head3 session
-
-A reference to the current session.
-
-=head3 properties
-
-A hash reference containing the properties for this vendor. See update() for details.
+Constructor. Creates a new vendor.  Really an alias for WebGUI::Shop::Vendor->new($session, $properties)
 
 =cut
 
 sub create {
     my ($class, $session, $properties) = @_;
-    unless (defined $session && $session->isa("WebGUI::Session")) {
-        WebGUI::Error::InvalidObject->throw(expected=>"WebGUI::Session", got=>(ref $session), error=>"Need a session.");
-    }
-    my $id = $session->id->generate;
-    $session->db->write("insert into vendor (vendorId, dateCreated) values (?, now())",[$id]);
-    my $self = $class->new($session, $id);
-    $self->update($properties);
-    return $self;
+    return $class->new($session, $properties);
 }
 
 #-------------------------------------------------------------------
@@ -70,51 +156,20 @@ Deletes this vendor.
 
 sub delete {
     my ($self) = @_;
-    $self->session->db->deleteRow("vendor","vendorId",$self->getId);
-}
-
-#-------------------------------------------------------------------
-
-=head2 get ( [ property ] )
-
-Returns a duplicated hash reference of this objectÕs data. See update() for details.
-
-=head3 property
-
-Any field returns the value of a field rather than the hash reference.
-
-=head3 Additional properties
-
-=head4 dateCreated
-
-The date this vendor was created in the system.
-
-=head4 vendorId
-
-The id of this vendor from the database.  Use getId() instead.
-
-=cut
-
-sub get {
-    my ($self, $name) = @_;
-    if (defined $name) {
-        return $properties{id $self}{$name};
-    }
-    my %copyOfHashRef = %{$properties{id $self}};
-    return \%copyOfHashRef;
+    $self->session->db->deleteRow("vendor", "vendorId", $self->vendorId);
 }
 
 #-------------------------------------------------------------------
 
 =head2 getId () 
 
-Returns the unique id of this item.
+Returns the unique id of this item.  You should use $self->vendorId instead.
 
 =cut
 
 sub getId {
     my $self = shift;
-    return $self->get("vendorId");
+    return $self->vendorId;
 }
 
 #-------------------------------------------------------------------
@@ -147,7 +202,7 @@ sub getPayoutTotals {
     my %totals = $self->session->db->buildHash(
         'select vendorPayoutStatus, sum(vendorPayoutAmount) as amount from transactionItem as t1, transaction as t2 '
         .'where t1.transactionId = t2.transactionId and t2.isSuccessful <> 0 and vendorId=? group by vendorPayoutStatus ',
-        [ $self->getId ]
+        [ $self->vendorId ]
     );
 
     # Format the payout categories and calc the total those.
@@ -204,10 +259,10 @@ sub isVendorInfoComplete {
     my $self = shift;
 
     my $complete = 
-           defined $self->get( 'name' )
-        && defined $self->get( 'userId' )
-        && defined $self->get( 'preferredPaymentType' )
-        && defined $self->get( 'paymentInformation' );
+           defined $self->name
+        && defined $self->userId
+        && defined $self->preferredPaymentType
+        && defined $self->paymentInformation;
 
     return $complete
 }
@@ -216,7 +271,12 @@ sub isVendorInfoComplete {
 
 =head2 new ( session, vendorId )
 
-Constructor.   Returns a WebGUI::Shop::Vendor object.
+=head2 new ( session, properties )
+
+=head2 new ( hashref )
+
+Constructor.   Returns a WebGUI::Shop::Vendor object, either by fetching information from the database,
+or using passed in properties.
 
 =head3 session
 
@@ -229,26 +289,44 @@ A unique id for a vendor that already exists in the database.  If the vendorId i
 in, then a WebGUI::Error::InvalidParam Exception will be thrown.  If the requested Id cannot
 be found in the database, then a WebGUI::Error::ObjectNotFound exception will be thrown.
 
+=head3 properties
+
+A hashref of properties to assign to the object when it is created.
+
+=head3 hashref
+
+A classic Moose-style hashref of options.  It must include a WebGUI::Session object.
+
+=head3 Attributes
+
+=head4 name
+
+The name of the vendor.
+
+=head4 userId
+
+The unique GUID of the vendor.
+
+=head4 url
+
+The vendor's url.
+
+=head4 vendorId
+
+A unique identifier for this vendor.  This option may be included in the properties for the new object, but it will
+be ignored.
+
+=head4 dateCreated
+
+The date this vendor was created, in database format.  This option may be included in the properties for the new object,
+but it will be ignored.
+
+=head4 paymentInformation
+
+=head4 preferredPaymentType
+
 =cut
 
-sub new {
-    my ($class, $session, $vendorId) = @_;
-    unless (defined $session && $session->isa("WebGUI::Session")) {
-        WebGUI::Error::InvalidObject->throw(expected=>"WebGUI::Session", got=>(ref $session), error=>"Need a session.");
-    }
-    unless (defined $vendorId) {
-        WebGUI::Error::InvalidParam->throw( param=>$vendorId, error=>"Need a vendorId.");
-    }
-    my $vendor = $session->db->quickHashRef("select * from vendor where vendorId=?",[$vendorId]);
-    if ($vendor->{vendorId} eq "") {
-        WebGUI::Error::ObjectNotFound->throw(error=>"Vendor not found.", id=>$vendorId);
-    }
-    my $self = register $class;
-    my $id        = id $self;
-    $session{ $id } = $session;
-    $properties{ $id } = $vendor;
-    return $self;
-}
 
 #-------------------------------------------------------------------
 
@@ -262,7 +340,7 @@ A reference to the current session.
 
 =head3 userId
 
-A unique userId. Will pull from the session if not specified.
+A unique userId.  Will pull from the session if not specified.
 
 =cut
 
@@ -289,44 +367,16 @@ Returns a reference to the current session.
 
 #-------------------------------------------------------------------
 
-=head2 update ( properties )
+=head2 write ( )
 
-Sets properties of the vendor
-
-=head3 properties
-
-A hash reference that contains one of the following:
-
-=head4 name
-
-The name of the vendor.
-
-=head4 userId
-
-The unique GUID of the vendor.
-
-=head4 url
-
-The vendor's url.
-
-=head4 paymentInformation
-
-????
-
-=head4 preferredPaymentType
-
-????
+Serializes the object's properties to the database
 
 =cut
 
-sub update {
-    my ($self, $newProperties) = @_;
-    my $id = id $self;
-    my @fields = (qw(name userId url paymentInformation preferredPaymentType));
-    foreach my $field (@fields) {
-        $properties{$id}{$field} = (exists $newProperties->{$field}) ? $newProperties->{$field} : $properties{$id}{$field};
-    }
-    $self->session->db->setRow("vendor","vendorId",$properties{$id});
+sub write {
+    my ($self) = @_;
+    my $properties = $self->get();
+    $self->session->db->setRow("vendor", "vendorId", $properties);
 }
 
 #-------------------------------------------------------------------
@@ -447,7 +497,7 @@ sub www_manage {
 			.WebGUI::Form::formHeader($session, {extras=>'style="float: left;"' })
             .WebGUI::Form::hidden($session, { name   => "shop",                value => "vendor" })
             .WebGUI::Form::hidden($session, { name   => "method",              value => "delete" })
-            .WebGUI::Form::hidden($session, { name   => "vendorId",    value => $vendor->getId })
+            .WebGUI::Form::hidden($session, { name   => "vendorId",    value => $vendor->vendorId })
             .WebGUI::Form::submit($session, { value  => $i18n->get("delete"), extras => 'class="backwardButton"' }) 
             .WebGUI::Form::formFooter($session)
 
@@ -455,12 +505,12 @@ sub www_manage {
             .WebGUI::Form::formHeader($session, {extras=>'style="float: left;"' })
             .WebGUI::Form::hidden($session, { name   => "shop",              value => "vendor" })
             .WebGUI::Form::hidden($session, { name   => "method",            value => "edit" })
-            .WebGUI::Form::hidden($session, { name   => "vendorId",  value => $vendor->getId })
+            .WebGUI::Form::hidden($session, { name   => "vendorId",  value => $vendor->vendorId })
             .WebGUI::Form::submit($session, { value  => $i18n->get("edit"), extras => 'class="normalButton"' })
             .WebGUI::Form::formFooter($session)
 
             # Append name
-            .' '. $vendor->get("name") 
+            .' '. $vendor->name 
         .'</div>';        
     }
 

lib/WebGUI/Storage.pm

@@ -259,7 +259,7 @@ sub addFileFromCaptcha {
         $self->session->errorHandler->warn("Error adding noise: $error");
     }
     # AddNoise generates a different average color depending on library.  This is ugly, but the best I can see for now
-    $error = $image->Annotate(font=>WebGUI::Paths->var.'/default.ttf', pointsize=>40, skewY=>0, skewX=>0, gravity=>'center', fill=>'#ffffff', antialias=>'true', text=>$challenge);
+    $error = $image->Annotate(font=>WebGUI::Paths->share.'/default.ttf', pointsize=>40, skewY=>0, skewX=>0, gravity=>'center', fill=>'#ffffff', antialias=>'true', text=>$challenge);
 	if($error) {
         $self->session->errorHandler->warn("Error Annotating image: $error");
     }
@@ -1284,7 +1284,7 @@ sub getUrl {
         and -e $self->getPath . '/.cdn' )
     {
         my $sep = '/';    # separator, if not already present trailing
-        if ($cdnCfg->{'sslAlt'} && $self->session->env->sslRequest) {
+        if ($cdnCfg->{'sslAlt'} && $self->session->request->secure) {
             if ( $cdnCfg->{'sslUrl'} ) {
                 substr( $cdnCfg->{'sslUrl'}, -1 ) eq '/' and $sep = '';
                 $url = $cdnCfg->{'sslUrl'} . $sep . $self->getDirectoryId;

lib/WebGUI/TabForm.pm

@@ -206,7 +206,7 @@ sub new {
 	}
 	my $i18n = WebGUI::International->new($session);
     my $cancelJS  = 'history.go(-1);';
-    if (my $cancelURL = $session->env->get('HTTP_REFERER')) {
+    if (my $cancelURL = $session->request->referer) {
         $cancelJS = sprintf q{window.location.href='%s';}, $cancelURL;
     }
 	my $cancel = WebGUI::Form::button($session,{

lib/WebGUI/Upgrade.pm

@@ -0,0 +1,559 @@
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=head1 NAME
+
+WebGUI::Upgrade - Perform upgrades on WebGUI sites
+
+=head1 SYNOPSIS
+
+    use WebGUI::Upgrade;
+    my $upgrade = WebGUI::Upgrade->new;
+    $upgrade->upgradeSites;
+
+=head1 DESCRIPTION
+
+This package calculates upgrade paths and performs upgrades for WebGUI sites.
+
+=head1 Differences from WebGUI 7's upgrade system
+
+In WebGUI 7 and prior, a single upgrade for each version was created
+as F<docs/upgrades/upgrade_X.X.X-X.X.X.pl>.  This script would be
+run with a command line parameter of --configFile=F<site.conf>.
+This script contained all of the code to set up a session and do
+any other work that was needed.
+
+To cut down on the amount of boilerplate code and allow for more
+flexible upgrades, this has been changed.  Multiple upgrade files
+are placed in the directory F<var/upgrades/X.X.X-X.X.X/>, and are
+processed in alphabetical order, with the file extension determining
+how to process the file.
+
+=head1 Supported File Types
+
+The file extension determines the class that will be used to process them.  The class is determined by appending it to C<WebGUI::Upgrade::File::>.
+
+=head2 Perl Scripts - F<.pl>
+
+Perl scripts are processed by L<WebGUI::Upgrade::File::pl>, which
+runs them after setting the environment variables C<WEBGUI_CONFIG>
+and C<WEBGUI_UPGRADE_VERSION>.  Usually, these scripts should use
+the module L<WebGUI::Upgrade::Script> to load a number of subs to
+greatly simplify how they are written.
+
+=head2 SQL Scripts - F<.sql>
+
+SQL scripts are processed by L<WebGUI::Upgrade::File::sql>, which
+runs them with the F<mysql> command line client.
+
+=head2 WebGUI Packages - F<.wgpkg>
+
+WebGUI packages are processed by L<WebGUI::Upgrade::File::wgpkg>,
+which imports them into the WebGUI site.
+
+=head2 Text and POD Documents - F<.txt>/F<.pod>
+
+Text and POD documents are processed by L<WebGUI::Upgrade::File::txt>
+and L<WebGUI::Upgrade::File::pod> respectively.  The files will be
+shown to the user running the upgrade, and will wait for user
+confirmation before continuing.  This will only be done once per
+upgrade process.
+
+=cut
+
+package WebGUI::Upgrade;
+use 5.010;
+use Moose;
+use WebGUI::Paths;
+use WebGUI::Pluggable;
+use WebGUI::Config;
+use WebGUI::SQL;
+use Try::Tiny;
+use File::Spec;
+use File::Path qw(make_path);
+use POSIX qw(strftime);
+use Cwd ();
+use namespace::autoclean;
+
+=head1 ATTRIBUTES
+
+These attributes can be set when creating a WebGUI::Upgrade instance:
+
+=cut
+
+=head2 quiet
+
+Whether information about the upgrade progress will be output.  Defaults to false.
+
+=cut
+
+has quiet => (
+    is => 'rw',
+    default => undef,
+);
+
+=head2 mysql
+
+The path to the mysql command line client.  Defaults to 'mysql'.
+
+=cut
+
+has mysql => (
+    is => 'rw',
+    default => 'mysql',
+);
+
+=head2 mysqldump
+
+The path to the mysqldump command line client.  Defaults to 'mysqldump'.
+
+=cut
+
+has mysqldump => (
+    is => 'rw',
+    default => 'mysqldump',
+);
+
+=head2 clearCache
+
+If true, the cache will be cleared for each site before running
+any upgrade scripts.  Defaults to true.
+
+=cut
+
+has clearCache => (
+    is      => 'rw',
+    default => 1,
+);
+
+=head2 backupPath
+
+The path where backups will be stored.  Defaults to 'backups' inside the temp directory.
+
+=cut
+
+has backupPath => (
+    is      => 'rw',
+    default => File::Spec->catdir(File::Spec->tmpdir, 'backups'),
+);
+
+=head2 createBackups
+
+If true, backups will be created before each version upgrade for
+each site.  The backup files will be named
+C<{config file}_{version}_{timestamp}.sql>.
+
+=cut
+
+has createBackups => (
+    is      => 'rw',
+    default => 1,
+);
+
+=head2 useMaintenanceMode
+
+If set, sites will be put into maintenance mode before any upgrades
+are run on them.  Defaults to true.
+
+=cut
+
+has useMaintenanceMode => (
+    is      => 'rw',
+    default => 1,
+);
+
+# this is used to store if a given upgrade file has been run yet.
+# Some upgrade files should only be processed once per upgrade.
+has _files_run => (
+    is      => 'rw',
+    default => sub { { } },
+);
+
+=head1 METHODS
+
+=head2 upgradeSites
+
+Upgrades all available sites to match the current WebGUI codebase.
+
+=cut
+
+sub upgradeSites {
+    my $self = shift;
+        require Carp;
+    my @configs = WebGUI::Paths->siteConfigs;
+    my $i = 0;
+    for my $configFile (@configs) {
+        $i++;
+        my $bareFilename = $configFile;
+        $bareFilename =~ s{.*/}{};
+        print "Upgrading $bareFilename (site $i/@{[ scalar @configs ]}):\n";
+        try {
+            $self->upgradeSite($configFile);
+        }
+        catch {
+            print "Error upgrading $bareFilename: $_\n";
+        };
+    }
+    return 1;
+}
+
+=head2 getCodeVersion
+
+Returns the current version of the codebase.
+
+=cut
+
+sub getCodeVersion {
+    require WebGUI;
+    return WebGUI->VERSION;
+}
+
+=head2 upgradeSite ( $config )
+
+Upgrades the given config file to the current codebase.
+
+=head3 $config
+
+The path to a WebGUI config file or a WebGUI::Config instance
+
+=cut
+
+sub upgradeSite {
+    my $self = shift;
+    my ($configFile) = @_;
+    my $fromVersion = $self->getCurrentVersion($configFile);
+    my $toVersion = $self->getCodeVersion;
+    my @steps = $self->calcUpgradePath($fromVersion, $toVersion);
+    if ( $self->useMaintenanceMode ) {
+        my $dbh = $self->dbhForConfig( $configFile );
+        $dbh->do('REPLACE INTO settings (name, value) VALUES (?, ?)', {}, 'upgradeState', 'started');
+    }
+    if (! @steps) {
+        print "No upgrades needed.\n";
+    }
+    my $i = 0;
+    for my $step ( @steps ) {
+        $i++;
+        print "Running upgrades for $step (step $i/@{[ scalar @steps ]}):\n";
+        $self->createBackup($configFile);
+        $self->runUpgradeStep($configFile, $step);
+    }
+}
+
+=head1 calcUpgradePath ( $fromVerson , $toVersion )
+
+Class method to calculate the upgrade path between two versions.
+Tries to find the best path between the versions by looking in
+F<var/upgrades/> for directories that make a path between the versions.
+Returns either a list of directories to use, or throws an error if
+no path can be found.
+
+=cut
+
+sub calcUpgradePath {
+    my $class = shift;
+    my ($fromVersionStr, $toVersionStr) = @_;
+    my $fromVersion = $class->_numericVersion($fromVersionStr);
+    my $toVersion = $class->_numericVersion($toVersionStr);
+
+    my %upgrades;
+    opendir my $dh, WebGUI::Paths->upgrades
+        or die "Upgrades directory doesn't exist.\n";
+    while ( my $dir = readdir $dh ) {
+        next
+            if $dir =~ /^\./;
+        next
+            unless -d File::Spec->catdir(WebGUI::Paths->upgrades, $dir);
+        if ($dir =~ /^((\d+\.\d+\.\d+)-(\d+\.\d+\.\d+))$/) {
+            $upgrades{ $class->_numericVersion($2) }{ $class->_numericVersion($3) } = $1;
+        }
+    }
+    closedir $dh;
+
+    my @steps;
+    while ( 1 ) {
+        my $atVersion = @steps ? $steps[-1][0] : $fromVersion;
+        last
+            if $atVersion eq $toVersion;
+
+        # find the available steps for the version we are at
+        my $stepsAvail = $upgrades{ $atVersion };
+        if ( $stepsAvail && %{ $stepsAvail } ) {
+            # take the lowest destination version, and remove it so it isn't considered again
+            my ($nextStep) = sort { $a <=> $b } keys %{ $stepsAvail };
+            my $dir = delete $stepsAvail->{$nextStep};
+            # add a step for that 
+            push @steps, [$nextStep, $dir];
+        }
+        # if we don't have any steps available, the last step we tried won't work so remove it
+        elsif ( @steps ) {
+            pop @steps;
+        }
+        # if there is no way forward and we can't backtrack, bail out
+        else {
+            die "Can't find upgrade path from $fromVersionStr to $toVersionStr.\n";
+        }
+    }
+    return map { $_->[1] } @steps;
+}
+
+=head2 runUpgradeStep ( $config , $step )
+
+Runs the given upgrade step against the WebGUI config file.
+
+=cut
+
+sub runUpgradeStep {
+    my $self = shift;
+    my ($configFile, $step) = @_;
+
+    my ($version) = $step =~ /-(\d+\.\d+\.\d+)$/;
+    my $upgradesDir = File::Spec->catdir(WebGUI::Paths->upgrades, $step);
+    opendir my($dh), $upgradesDir or die "Can't get upgrades for $step: $!\n";
+    while ( my $upgradeFile = readdir $dh ) {
+        next
+            if $upgradeFile =~ /^\./;
+        my $filename = File::Spec->catfile($upgradesDir, $upgradeFile);
+        next
+            unless -f $filename;
+        $self->runUpgradeFile($configFile, $version, $filename);
+    }
+    closedir $dh;
+    $self->markVersionUpgrade($configFile, $version);
+}
+
+=head2 runUpgradeFile ( $config , $version , $filename )
+
+Runs the given upgrade file against a WebGUI config file.
+
+=head3 $version
+
+The destination version for the step this upgrade file is part of.
+
+=cut
+
+sub runUpgradeFile {
+    my $self = shift;
+    my ($configFile, $version, $filename) = @_;
+    my $has_run = $self->_files_run->{ Cwd::realpath($filename) } ++;
+
+    return try {
+        my $upgrade_class = $self->classForFile($filename);
+        my $upgrade_file = $upgrade_class->new(
+            version     => $version,
+            file        => $filename,
+            upgrade     => $self,
+        );
+        if ($has_run && $upgrade_file->once) {
+            return;
+        }
+        $upgrade_file->run($configFile);
+    }
+    catch {
+        when (/^No upgrade package/) {
+            warn $_;
+            return;
+        }
+        default {
+            die $_;
+        }
+    };
+}
+
+=head2 classForFile ( $file )
+
+Class method to find the class to use to run the upgrade file.
+Given a filename, it will either load and return a class name to
+use, or throw an error if no appropriate class is available.
+
+=cut
+
+sub classForFile {
+    my $class = shift;
+    my $file = shift;
+    my ($extension) = $file =~ /\.([^.]+)$/;
+    if ($extension) {
+        my $package = 'WebGUI::Upgrade::File::' . $extension;
+        WebGUI::Pluggable::load($package);
+        return $package
+            if $package->DOES('WebGUI::Upgrade::File');
+    }
+    no warnings 'uninitialized';
+    die "No upgrade package for extension: $extension";
+}
+
+=head2 markVersionUpgrade ( $config , $version )
+
+Marks that a given version upgrade has been completed for a config file.
+
+=cut
+
+sub markVersionUpgrade {
+    my $self = shift;
+    my $configFile = shift;
+    my $version = shift;
+
+    my $dbh = $self->dbhForConfig($configFile);
+
+    $dbh->do(
+        'INSERT INTO webguiVersion (webguiVersion, versionType, dateApplied) VALUES (?,?,?)', {},
+        $version, 'upgrade', time,
+    );
+    if ( $self->useMaintenanceMode ) {
+        $dbh->do('REPLACE INTO settings (name, value) VALUES (?, ?)', {}, 'upgradeState', $version);
+    }
+}
+
+=head2 createBackup ( $config )
+
+Creates a database backup file for a given config file.
+
+=cut
+
+sub createBackup {
+    my $self = shift;
+    my $config = shift;
+    if (! ref $config) {
+        $config = WebGUI::Config->new($config);
+    }
+
+    make_path($self->backupPath);
+    my $configFile = ( File::Spec->splitpath($config->pathToFile) )[2];
+    my $resultFile = File::Spec->catfile(
+        $self->backupPath,
+        $configFile . '_' . $self->getCurrentVersion($config) . '_' . time . '.sql',
+    );
+    print "Backing up to $resultFile\n";
+    my @command_line = (
+        $self->mysqldump,
+        $self->mysqlCommandLine($config),
+        '--add-drop-table',
+        '--result-file=' . $resultFile,
+    );
+    system { $command_line[0] } @command_line
+        and die "$!";
+}
+
+=head2 reportHistory ( $config )
+
+Class method to return the upgrade history for a given config file.
+
+=cut
+
+sub reportHistory {
+    my $class = shift;
+    my $config = shift;
+    my $dbh = $class->dbhForConfig($config);
+    my $sth = $dbh->prepare('SELECT webguiVersion, dateApplied, versionType FROM webguiVersion ORDER BY dateApplied ASC, webguiVersion ASC');
+    $sth->execute;
+    while ( my @data = $sth->fetchrow_array ) {
+        printf "\t%-8s  %-15s  %-15s\n", $data[0], strftime('%D %T', localtime $data[1]), $data[2];
+    }
+    $sth->finish;
+}
+
+=head2 getCurrentVersion ( $config )
+
+Class method that returns the current version of a WebGUI database.
+
+=cut
+
+sub getCurrentVersion {
+    my $class = shift;
+    my $configFile = shift;
+    my $dbh = $class->dbhForConfig($configFile);
+
+    my $sth = $dbh->prepare('SELECT webguiVersion FROM webguiVersion');
+    $sth->execute;
+    my ($version) = map { $_->[0] }
+        sort { $b->[1] <=> $a->[1] }
+        map { [ $_->[0], $class->_numericVersion($_->[0]) ] }
+        @{ $sth->fetchall_arrayref( [0] ) };
+    $sth->finish;
+    return $version;
+}
+
+=head2 dbhForConfig ( $config )
+
+Class method that creates a new WebGUI::SQL object given a config file.
+
+=cut
+
+sub dbhForConfig {
+    my $class = shift;
+    my $config = shift;
+    if (! ref $config) {
+        $config = WebGUI::Config->new($config);
+    }
+    return WebGUI::SQL->connect($config);
+}
+
+=head2 mysqlCommandLine ( $config )
+
+Class method to return a list of options to pass to the mysql or
+mysqldump command line client to connect to the given config file's
+database.
+
+=cut
+
+sub mysqlCommandLine {
+    my $class = shift;
+    my $config = shift;
+    if (! ref $config) {
+        $config = WebGUI::Config->new($config);
+    }
+
+    my $dsn = $config->get('dsn');
+    my $username = $config->get('dbuser');
+    my $password = $config->get('dbpass');
+    my $database = ( split /[:;]/msx, $dsn )[2];
+    my $hostname = 'localhost';
+    my $port = '3306';
+    while ( $dsn =~ /([^=;:]+)=([^;:]+)/msxg ) {
+        if ( $1 eq 'host' || $1 eq 'hostname' ) {
+            $hostname = $2;
+        }
+        elsif ( $1 eq 'db' || $1 eq 'database' || $1 eq 'dbname' ) {
+            $database = $2;
+        }
+        elsif ( $1 eq 'port' ) {
+            $port = $2;
+        }
+    }
+
+    my @command_line = (
+        '-h' . $hostname,
+        '-P' . $port,
+        $database,
+        '-u' . $username,
+        ( $password ? '-p' . $password : () ),
+        '--default-character-set=utf8',
+    );
+    return @command_line;
+}
+
+# converts a period separated version number into a form that can
+# be compared numerically.
+sub _numericVersion {
+    my $class = shift;
+    my $version = shift;
+    my @parts = split /\./, $version;
+    my $decVersion = 0;
+    for my $i (0..$#parts) {
+        $decVersion += $parts[$i] / (1000**$i);
+    }
+    return $decVersion;
+}
+
+__PACKAGE__->meta->make_immutable;
+1;
+

lib/WebGUI/Upgrade/File.pm

@@ -0,0 +1,101 @@
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=head1 NAME
+
+WebGUI::Upgrade::File - Role for upgrade file classes
+
+=head1 SYNOPSIS
+
+    package WebGUI::Upgrade::File::ext;
+    with 'WebGUI::Upgrade::File';
+
+    sub run {
+        my $self = shift;
+        print "Running " . $self->file . "\n";
+    }
+
+=head1 DESCRIPTION
+
+To be consumed by classes for running upgrade scripts.
+
+=cut
+
+package WebGUI::Upgrade::File;
+use 5.010;
+use Moose::Role;
+
+=head1 REQUIRED METHODS
+
+Classes consuming this role must implement the following methods:
+
+=head2 run
+
+This method much be implemented and should run the actual upgrade file on the config file.
+
+=cut
+
+requires 'run';
+
+=head1 ATTRIBUTES
+
+This role includes the following attributes.
+
+=cut
+
+=head2 file
+
+The upgrade file to run.
+
+=cut
+
+has file => (
+    is       => 'ro',
+    required => 1,
+);
+
+=head2 version
+
+The version the upgrade is for.
+
+=cut
+
+has version => (
+    is       => 'ro',
+    required => 1,
+);
+
+=head2 upgrade
+
+The WebGUI::Upgrade object to use for this upgrade.
+
+=cut
+
+has upgrade => (
+    is       => 'ro',
+    required => 1,
+    handles  => [ 'quiet' ],
+);
+
+=head1 METHODS
+
+=head2 once
+
+A method to be overridden that controls if the upgrade file should
+be run more than once per server.
+
+=cut
+
+sub once { 0 }
+
+1;
+

lib/WebGUI/Upgrade/File/pl.pm

@@ -0,0 +1,79 @@
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=head1 NAME
+
+WebGUI::Upgrade::File::pl - Upgrade class for Perl scripts
+
+=cut
+
+package WebGUI::Upgrade::File::pl;
+use Moose;
+use Class::MOP::Class;
+use File::Spec::Functions qw(devnull);
+use Scope::Guard;
+use namespace::autoclean -also => qr/^_/;
+
+with 'WebGUI::Upgrade::File';
+
+sub run {
+    my $self = shift;
+    my $configFile = shift;
+
+    local $ENV{WEBGUI_CONFIG}           = $configFile;
+    local $ENV{WEBGUI_UPGRADE_VERSION}  = $self->version;
+    my $io_guard;
+    if ($self->quiet) {
+        open my $stdout_old, '>&=', \*STDOUT;
+        open \*STDOUT, '>', devnull;
+        $io_guard = Scope::Guard->new(sub {
+            close STDOUT;
+            open STDOUT, '>&=', $stdout_old;
+        });
+    }
+    return _runScript($self->file);
+}
+
+sub _runScript {
+    my $file = shift;
+    my @res;
+    my $err;
+    {
+        local $@;
+        local *_;
+        # use an anonymous package for this code.  the namespace will
+        # automatically be deleted when this goes out of scope.
+        my $anon_class = Class::MOP::Class->create_anon_class;
+        my $wanted = wantarray;
+        eval sprintf(<<'END_CODE', $anon_class->name);
+            package %s;
+            # maintain context
+            if ($wanted) {
+                @res = do $file;
+            }
+            elsif (defined $wanted) {
+                $res[0] = do $file;
+            }
+            else {
+                do $file;
+            }
+            # save error as soon as possible, before local removes it
+            $err = $@;
+END_CODE
+    }
+    die $err
+        if $err;
+    return (wantarray ? @res : $res[0]);
+}
+
+__PACKAGE__->meta->make_immutable;
+1;

lib/WebGUI/Upgrade/File/pod.pm

@@ -0,0 +1,45 @@
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=head1 NAME
+
+WebGUI::Upgrade::File::pod - Upgrade class for POD documents
+
+=cut
+
+package WebGUI::Upgrade::File::pod;
+use Moose;
+use POSIX qw(_exit);
+with 'WebGUI::Upgrade::File';
+
+sub once { 1 }
+
+sub run {
+    my $self = shift;
+    my $configFile = shift;
+    if ( ! $self->quiet ) {
+        my $pid = fork;
+        if (! $pid) {
+            require Pod::Perldoc;
+            @ARGV = ($self->file);
+            Pod::Perldoc->run;
+            _exit;
+        }
+        waitpid $pid, 0;
+    }
+
+    return 1;
+}
+
+__PACKAGE__->meta->make_immutable;
+1;
+

lib/WebGUI/Upgrade/File/sql.pm

@@ -0,0 +1,41 @@
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=head1 NAME
+
+WebGUI::Upgrade::File::sql - Upgrade class for SQL scripts
+
+=cut
+
+package WebGUI::Upgrade::File::sql;
+use Moose;
+with 'WebGUI::Upgrade::File';
+
+sub run {
+    my $self = shift;
+    my $configFile = shift;
+
+    my @command_line = (
+        $self->upgrade->mysql,
+        $self->upgrade->mysqlCommandLine($configFile),
+        '--batch',
+        '--execute=source ' . $self->file,
+    );
+
+    system { $command_line[0] } @command_line
+        and die "$!";
+    return 1;
+}
+
+__PACKAGE__->meta->make_immutable;
+1;
+

lib/WebGUI/Upgrade/File/txt.pm

@@ -0,0 +1,45 @@
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=head1 NAME
+
+WebGUI::Upgrade::File::txt - Upgrade class for text documents
+
+=cut
+
+package WebGUI::Upgrade::File::txt;
+use Moose;
+with 'WebGUI::Upgrade::File';
+
+sub once { 1 }
+
+sub run {
+    my $self = shift;
+    my $configFile = shift;
+    if ( ! $self->quiet ) {
+        open my $fh, '<', $self->file;
+        while ( my $line = <$fh> ) {
+            print $line;
+        }
+        close $fh;
+        if (-t) {
+            print "\nPress ENTER to continue... ";
+            my $nothing = <>;
+        }
+    }
+
+    return 1;
+}
+
+__PACKAGE__->meta->make_immutable;
+1;
+

lib/WebGUI/Upgrade/File/wgpkg.pm

@@ -0,0 +1,88 @@
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=head1 NAME
+
+WebGUI::Upgrade::File::wgpkg - Upgrade class for WebGUI packages
+
+=cut
+
+package WebGUI::Upgrade::File::wgpkg;
+use Moose;
+with 'WebGUI::Upgrade::File';
+
+use WebGUI::Asset;
+use WebGUI::Session;
+use WebGUI::Storage;
+use WebGUI::VersionTag;
+use File::Spec;
+use Try::Tiny;
+use namespace::clean;
+
+sub run {
+    my $self = shift;
+    my $configFile = shift;
+
+    my $session = WebGUI::Session->open($configFile);
+    $session->user({userId => 3});
+
+    my $versionTag = WebGUI::VersionTag->getWorking($session);
+    (undef, undef, my $shortname) = File::Spec->splitpath($self->file);
+    $shortname =~ s/\.[^.]*$//;
+    $versionTag->set({name => "Upgrade to @{[$self->version]} - $shortname"});
+
+    my $package = $self->import_package($session, $self->file);
+    if (! $self->quiet) {
+        printf "\tImported '%s'\n", $package->title;
+    }
+
+    $versionTag->commit;
+    $session->var->end;
+    $session->close;
+
+    return $package;
+}
+
+sub import_package {
+    my $class = shift;
+    my ($session, $file) = @_;
+
+    # Make a storage location for the package
+    my $storage = WebGUI::Storage->createTemp( $session );
+    $storage->addFileFromFilesystem( $file );
+
+    # Import the package into the import node
+    my $package = try {
+        my $node = WebGUI::Asset->getImportNode($session);
+        $node->importPackage( $storage, {
+            overwriteLatest    => 1,
+            clearPackageFlag   => 1,
+            setDefaultTemplate => 1,
+        } );
+    }
+    catch {
+        $storage->delete;
+        die "Error during package import on $file: $_";
+    };
+
+    $storage->delete;
+
+    if ($package eq 'corrupt') {
+        die "Corrupt package found in $file.\n";
+    }
+
+    return $package;
+}
+
+__PACKAGE__->meta->make_immutable;
+1;
+

lib/WebGUI/Upgrade/Script.pm

@@ -0,0 +1,344 @@
+package WebGUI::Upgrade::Script;
+use 5.010;
+use strict;
+use warnings;
+use feature ();
+
+use Sub::Exporter;
+use Sub::Name;
+use WebGUI::Upgrade ();
+use Scope::Guard;
+use Scalar::Util qw(weaken);
+
+my $exporter = Sub::Exporter::build_exporter({
+    groups => {
+        default => \&_build_exports,
+    },
+});
+
+my $caller_upgrade_file;
+sub import {
+    my ($class, @args) = @_;
+    my $extra = shift @args if ref $args[0] eq 'HASH';
+    $extra ||= {};
+    if ( !$extra->{into} ) {
+        $extra->{into_level} ||= 0;
+        $extra->{into_level}++;
+    }
+
+    # save this in a lexical so _build_exports can pull it out
+    $caller_upgrade_file = File::Spec->rel2abs( (caller 0)[1] );
+
+    feature->import(':5.10');
+    strict->import;
+    warnings->import;
+    warnings->unimport('uninitialized');
+    $class->$exporter( $extra, @args );
+}
+
+my @cleanups;
+
+sub _build_exports {
+    my $configFile   = $ENV{WEBGUI_CONFIG}
+        or die 'WEBGUI_CONFIG environment variable must be specified';
+    my $version      = $ENV{WEBGUI_UPGRADE_VERSION}
+        or die 'WEBGUI_UPGRADE_VERSION must be set';
+    my $upgrade_file = $caller_upgrade_file;
+    (my $vol, my $dir, my $shortname) = File::Spec->splitpath( $upgrade_file );
+    $shortname =~ s/\.[^.]*$//;
+
+    # need to be able to reference these directly in the cleanup code
+    my $session;
+    my $versionTag;
+
+    # these subs are kept separate so the others can call them
+    my $config_sub = sub () {
+        state $config = do {
+            require WebGUI::Config;
+            WebGUI::Config->new($configFile);
+        };
+        return $config;
+    };
+    my $session_sub = sub () {
+        return $session
+            if $session && ! $session->closed;
+
+        require WebGUI::Session;
+        $session = WebGUI::Session->open($config_sub->());
+        $session->user({userId => 3});
+        return $session;
+    };
+    my $version_tag_sub = sub (;$) {
+        my $name = shift;
+        require WebGUI::VersionTag;
+        if ($versionTag) {
+            if ($name) {
+                $versionTag->commit;
+            }
+            elsif ( ! $versionTag->get('isCommitted') ) {
+                return $versionTag;
+            }
+        }
+        $name ||= $shortname;
+        $versionTag = WebGUI::VersionTag->getWorking($session_sub->());
+        $versionTag->set({name => "Upgrade to $version - $name"});
+        return $versionTag;
+    };
+    my $dbh_sub = sub () {
+        state $dbh = do {
+            WebGUI::Upgrade->dbhForConfig($config_sub->());
+        };
+        return $dbh;
+    };
+    my $collateral_sub = sub () {
+        state $collateral = do {
+            my $path = File::Spec->catpath($vol, File::Spec->catdir($dir, $shortname), '');
+            Path::Class::Dir->new($path);
+        };
+        return $collateral;
+    };
+
+    my $cleanup = sub {
+        state $has_run = 0;
+        return
+            if $has_run++;
+        if ($session) {
+            require WebGUI::VersionTag;
+            if (WebGUI::VersionTag->getWorking($session, 'nocreate')) {
+                $version_tag_sub->()->commit;
+            }
+            $session->var->end;
+            $session->close;
+        }
+        undef $session;
+        undef $versionTag;
+    };
+    my $cleanup_guard = Scope::Guard->new( $cleanup );
+
+    # we keep a weakened copy around.  this prevents us from keeping a
+    # copy if the guard gets freed, but otherwise allows us to call it
+    # manually in END.
+    push @cleanups, $cleanup;
+    weaken $cleanups[-1];
+
+    my $indent = 0;
+    my $just_started;
+
+    my $subs = {
+        # this closes over the guard, keeping it alive until the sub is either
+        # run or deleted.  WebGUI::Upgrade::File::pl will end up deleting
+        # the sub when it cleans up the temporary namespace it uses.
+        _cleanup => sub {
+            undef $cleanup_guard;
+        },
+        config      => $config_sub,
+        session     => $session_sub,
+        version_tag => $version_tag_sub,
+        dbh         => $dbh_sub,
+        collateral  => $collateral_sub,
+        start_step  => sub (@) {
+            print "\n"
+                if $just_started;
+            print "\t" x $indent, @_, '... ';
+            $just_started = 1;
+            $indent++;
+        },
+        report => sub (@) {
+            print "\n"
+                if $just_started;
+            print "\t" x $indent, @_, "\n";
+            $just_started = 0;
+        },
+        done => sub () {
+            $indent--;
+            print "\t" x $indent
+                unless $just_started;
+            print "Done.\n";
+            $just_started = 0;
+        },
+        sql => sub (@) {
+            my $sql = shift;
+            my $dbh = $dbh_sub->();
+            my $sth = $dbh->prepare($sql);
+            $sth->execute(@_);
+        },
+        rm_lib => sub (@) {
+            my @modules = @_;
+            for my $module (@modules) {
+                $module =~ s{::}{/}g;
+                $module .= '.pm';
+                for my $inc (@INC) {
+                    my $fullPath = File::Spec->catfile($inc, $module);
+                    unlink $fullPath;
+                }
+            }
+        },
+        import_package => sub (@) {
+            my $fullPath = $collateral_sub->()->file(@_);
+            require WebGUI::Upgrade::File::wgpkg;
+            WebGUI::Upgrade::File::wgpkg->import_package($session_sub->(), $fullPath);
+        },
+        root_asset => sub () {
+            require WebGUI::Asset;
+            return WebGUI::Asset->getRoot($session_sub->());
+        },
+        import_node => sub () {
+            require WebGUI::Asset;
+            return WebGUI::Asset->getImportNode($session_sub->());
+        },
+        asset => sub ($) {
+            require WebGUI::Asset;
+            my $session = $session_sub->();
+            my $assetId = shift;
+            my $asset;
+            if ($session->id->valid($assetId)) {
+                try {
+                    $asset = WebGUI::Asset->newById($session, $assetId);
+                };
+            }
+            if ( ! $asset ) {
+                $asset = WebGUI::Asset->newByUrl($session, $assetId);
+            }
+            return $asset;
+        },
+        clear_cache => sub () {
+            my $session = $session_sub->();
+            my $cache = $session->cache;
+            $cache->clear;
+        },
+    };
+    # give the subs some names to help with diagnostics
+    my $sub_package = $shortname;
+    $sub_package =~ s/\W//g;
+    for my $sub_name ( keys %$subs ) {
+        subname join('::', __PACKAGE__, $sub_package, $sub_name) => $subs->{$sub_name};
+    }
+    return $subs;
+}
+
+END {
+    for my $cleanup (@cleanups) {
+        # could be a weakened ref that went away
+        next
+            unless $cleanup;
+        $cleanup->();
+    }
+}
+
+1;
+
+__END__
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=head1 NAME
+
+WebGUI::Upgrade::Script - Utility package for WebGUI upgrade scripts
+
+=head1 SYNOPSIS
+
+    use WebGUI::Upgrade::Script;
+
+    print "Adding new snippet.\n";
+    import_node->addChild({ className => 'WebGUI::Asset::Snippet', title => 'New Snippet'});
+    config->set('config/item', 'new value');
+    done;
+
+=head1 DESCRIPTION
+
+This is a package to be used in upgrade scripts to provide a number
+of functions and automatic cleanup to make writing upgrade scripts
+faster and simpler.
+
+C<use>ing this module will also enable strictures, warnings, and
+all of Perl 5.10's syntax enhancements in the caller.
+
+=head1 ENVIRONMENT
+
+This package will use the following environment variables to determine
+its operation.  These variables are automatically set by
+L<WebGUI::Upgrade::File::pl> if run through the main upgrade system.
+
+=head2 WEBGUI_CONFIG
+
+The WebGUI config file to operate against.
+
+=head2 WEBGUI_UPGRADE_VERSION
+
+The version being upgraded to.
+
+=head1 EXPORTED SUBROUTINES
+
+These subroutines are all exported by default using L<Sub::Exporter>.
+They cannot be called directly.
+
+=head2 report ( $message )
+
+Outputs $message.
+
+=head2 done
+
+Reports that the current step has been completed.
+
+=head2 config
+
+Returns the WebGUI::Config object for the site.
+
+=head2 session
+
+Returns a session for the site.
+
+=head2 dbh
+
+Returns a database handle for the site's database.
+
+=head2 version_tag ( [ $name ] )
+
+If $name is specified, creates a new version tag with that name,
+sets it as the active version tag, and returns it
+
+If $name is not specified, returns the current working version tag,
+creating it if needed.
+
+The actual name of the version tag will automatically include a
+note specifying that it is an upgrade version tag.
+
+=head2 rm_lib ( $module )
+
+Deletes the specified Perl module.  The module should be specified
+as a colon separated name, and it will be removed from all include
+paths.
+
+=head2 collateral
+
+Returns a L<Path::Class::Dir> object for the upgrade script's collateral
+path.  The collateral path is the same as the name of the upgrade
+script with the extension stripped off.
+
+=head2 import_package ( $package_file )
+
+Imports the specified package from the upgrade script's collateral path.
+
+=head2 root_asset
+
+Returns the site's root asset.
+
+=head2 import_node
+
+Returns the site's import node.
+
+=head2 asset ( $assetId_or_URL )
+
+Returns an asset based on an asset ID or URL.
+
+=cut

lib/WebGUI/User.pm

@@ -299,7 +299,7 @@ sub canUseAdminMode {
 	my $pass = 1;
 	my $subnets = $self->session->config->get("adminModeSubnets") || [];
 	if (scalar(@$subnets)) {
-		$pass = WebGUI::Utility::isInSubnet($self->session->env->getIp, $subnets);
+		$pass = WebGUI::Utility::isInSubnet($self->session->request->address, $subnets);
 	}
 
 	return $pass && $self->isInGroup(12)

lib/WebGUI/Workflow/Activity/TrashExpiredEvents.pm

@@ -81,8 +81,8 @@ sub execute {
     my $date = WebGUI::DateTime->new($session, time() - $self->get("trashAfter") );
     my $sth  = $session->db->read( "select Event.assetId, revisionDate from Event join assetData using (assetId, revisionDate) where endDate < ? and revisionDate = (select max(revisionDate) from assetData where assetData.assetId=Event.assetId);", [ $date->toDatabaseDate ]);
     EVENT: while ( my ($id) = $sth->array ) {
-        my $asset = eval { WebGUI::Asset::Event->newById($self->session, $id); };
-        if (! Exception::Class->caught() ) {
+        my $asset = eval { WebGUI::Asset->newById($session, $id); };
+        if (! Exception::Class->caught()) {
             $asset->trash;
         }
         last EVENT if time() > $finishTime;

sbin/spectre.pl

@@ -18,7 +18,7 @@ use File::Spec;
 use POE::Component::IKC::ClientLite;
 use Spectre::Admin;
 use WebGUI::Paths -inc;
-use WebGUI::Config;
+use Config::JSON;
 use JSON;
 
 $|=1; # disable output buffering
@@ -47,7 +47,7 @@ GetOptions(
 pod2usage( verbose => 2 ) if $help;
 pod2usage() unless ($ping||$shutdown||$daemon||$run||$test||$status);
 
-my $config = WebGUI::Config->new( WebGUI::Paths->spectreConfig, 1);
+my $config = Config::JSON->new( WebGUI::Paths->spectreConfig);
 unless (defined $config) {
 	print <<STOP;
 

sbin/testEnvironment.pl

@@ -71,6 +71,7 @@ checkModule("Test::Exception",              0.27,      2 );
 checkModule("Test::Class",                  0.31,      2 );
 checkModule("Pod::Coverage",                0.19,      2 );
 checkModule("Text::Balanced",               2.00,      2 );
+checkModule("Capture::Tiny",                0.08,      2 );
 checkModule("Digest::MD5",                  2.38         );
 checkModule("DBI",                          1.607        );
 checkModule("DBD::mysql",                   4.010        );

sbin/upgrade.pl

@@ -11,47 +11,42 @@
 #-------------------------------------------------------------------
 
 use strict;
-use Cwd ();
-use File::Path ();
-use File::Spec;
+use warnings;
+use WebGUI::Paths -inc;
+use WebGUI::Upgrade;
 use Getopt::Long ();
 use Pod::Usage ();
-use WebGUI::Paths -inc;
-
-use WebGUI::Config;
-use WebGUI::Session;
-
-my $help;
-my $history;
-my $override;
-my $quiet;
-my $mysql = "mysql";
-my $mysqldump = "mysqldump";
-my $backupDir = "/tmp/backups";
-my $skipBackup;
-my $skipDelete;
-my $skipMaintenance;
-my $doit;
 
 Getopt::Long::GetOptions(
-        'help'=>\$help,
-        'history'=>\$history,
-        'override'=>\$override,
-        'quiet'=>\$quiet,
-	'mysql=s'=>\$mysql,
-	'doit'=>\$doit,
-	'skipDelete' =>\$skipDelete,
-	'skipMaintenance' =>\$skipMaintenance,
-	'mysqldump=s'=>\$mysqldump,
-	'backupDir=s'=>\$backupDir,
-	'skipbackup'=>\$skipBackup
-);
+    'help'              => \( my $help ),
+    'history'           => \( my $history ),
+    'override'          => \( my $override ),
+    'quiet'             => \( my $quiet ),
+    'doit'              => \( my $doit ),
+    'skipDelete'        => \( my $skipDelete ),
+    'skipMaintenance'   => \( my $skipMaintenance ),
+    'skipbackup'        => \( my $skipBackup ),
+    'backupDir=s'       => \( my $backupDir ),
+    'mysql=s'           => \( my $mysql ),
+    'mysqldump=s'       => \( my $mysqldump ),
+) or Pod::Usage::pod2usage(2);
 
-Pod::Usage::pod2usage( verbose => 2 ) if $help;
-Pod::Usage::pod2usage() unless $doit;
-
-unless ($doit) {
-	print <<STOP;
+if ($help) {
+    Pod::Usage::pod2usage(
+        -verbosity => 1,
+        -exitval => 1,
+    );
+}
+elsif ($history) {
+    for my $config (WebGUI::Paths->siteConfigs) {
+        print "$config:\n";
+        WebGUI::Upgrade->reportHistory($config);
+        print "\n";
+    }
+    exit;
+}
+elsif ( ! $doit ) {
+    my $message = <<'END_MESSAGE';
 
 +--------------------------------------------------------------------+
 |                                                                    |
@@ -75,314 +70,41 @@ unless ($doit) {
 |                                                                    |
 +--------------------------------------------------------------------+
 
-STOP
-	exit;
+END_MESSAGE
+    Pod::Usage::pod2usage($message);
 }
 
-
-if (!($^O =~ /^Win/i) && $> != 0 && !$override) {
-	print "You must be the super user to use this utility.\n";
-	exit;
+if ( $^O ne 'MSWin32' && $> != 0 && !$override ) {
+    print "You must be the super user to use this utility.\n";
+    exit;
 }
 
 ## Globals
 
-$| = 1;
-our $perl = $^X;
-our $slash;
-if ($^O =~ /^Win/i) {
-	$slash = "\\";
-} else {
-	$slash = "/";
-}
-our $upgradesPath = WebGUI::Paths->upgrades;
-our (%upgrade, %config);
+my $upgrade = WebGUI::Upgrade->new(
+    quiet               => $quiet,
+    clearCache          => ! $skipDelete,
+    createBackups       => ! $skipBackup,
+    useMaintenanceMode  => ! $skipMaintenance,
+    $mysql ? (
+        mysql               => $mysql,
+    ) : (),
+    $mysqldump ? (
+        mysqldump           => $mysqldump,
+    ) : (),
+    $backupDir ? (
+        backupPath          => $backupDir,
+    ) : (),
+);
 
+$upgrade->upgradeSites;
 
-## Find site configs.
+print <<STOP;
 
-print "\nGetting site configs...\n" unless ($quiet);
-my $configs = WebGUI::Config->readAllConfigs;
-foreach my $filename (keys %{$configs}) {
-	print "\tProcessing $filename.\n" unless ($quiet);
-	$config{$filename}{configFile} = $filename;
-	$config{$filename}{dsn} = $configs->{$filename}->get("dsn");
-	my $temp = _parseDSN($config{$filename}{dsn}, ['database', 'host', 'port']);
-	if ($temp->{'driver'} eq "mysql") {
-		$config{$filename}{db} = $temp->{'database'};
-		$config{$filename}{host} = $temp->{'host'};
-		$config{$filename}{port} = $temp->{'port'};
-		$config{$filename}{dbuser} = $configs->{$filename}->get("dbuser");
-		$config{$filename}{dbpass} = $configs->{$filename}->get("dbpass");
-		$config{$filename}{mysqlCLI} = $configs->{$filename}->get("mysqlCLI");
-		$config{$filename}{mysqlDump} = $configs->{$filename}->get("mysqlDump");
-		$config{$filename}{backupPath} = $configs->{$filename}->get("backupPath");
-		my $session = WebGUI::Session->open($filename);
-		($config{$filename}{version}) = $session->db->quickArray("select webguiVersion from webguiVersion order by
-        dateApplied desc, length(webguiVersion) desc, webguiVersion desc limit 1");
-		unless ($history) {
-			print "\tPreparing site for upgrade.\n" unless ($quiet);
-			unless ($skipMaintenance) {
-				$session->setting->remove('specialState');
-				$session->setting->add('specialState','upgrading');
-			}
-			unless ($skipDelete) {
-				print "\tDeleting temp files.\n" unless ($quiet);
-				my $path = File::Spec->catdir($configs->{$filename}->get("uploadsPath"), 'temp');
-				File::Path::rmtree($path) unless ($path eq "" || $path eq "/" || $path eq "/data");
-				print "\tDeleting file cache.\n" unless ($quiet);
-				$path = $configs->{$filename}->get("fileCacheRoot") || "/tmp/WebGUICache";
-				File::Path::rmtree($path)  unless ($path eq "" || $path eq "/" || $path eq "/data");
-			}
-		}
-		$session->close();
-	} else {
-		delete $config{$filename};
-		print "\tSkipping non-MySQL database.\n" unless ($quiet);
-	}
-}
-
-if ($history) {
-	print "\nDisplaying upgrade history for each site.\n";
-	foreach my $file (keys %config) {
-		print "\n".$file."\n";
-		my $session = WebGUI::Session->open($file);
-		my $sth = $session->db->read("select * from webguiVersion order by dateApplied asc, webguiVersion asc");
-		while (my $data = $sth->hashRef) {
-			print "\t".sprintf("%-8s  %-15s  %-15s",
-				$data->{webguiVersion},
-				$session->datetime->epochToHuman($data->{dateApplied},"%y-%m-%d"),
-				$data->{versionType})."\n";
-		}
-		$sth->finish;
-		$session->close;
-	}
-	exit;
-}
-
-## Find upgrade files.
-
-print "\nLooking for upgrade files...\n" unless ($quiet);
-opendir(DIR,$upgradesPath) or die "Couldn't open $upgradesPath\n";
-my @files = readdir(DIR);
-closedir(DIR);
-foreach my $file (@files) {
-	if ($file =~ /^upgrade_(\d+\.\d+\.\d+)-(\d+\.\d+\.\d+)\.(pl|sql)$/) {
-		if (checkVersion($1)) {
-			if ($3 eq "sql") {
-				print "\tFound upgrade script from $1 to $2.\n" unless ($quiet);
-				$upgrade{$1}{sql} = $file;
-			} elsif ($3 eq "pl") {
-				print "\tFound upgrade executable from $1 to $2.\n" unless ($quiet);
-				$upgrade{$1}{pl} = $file;
-			}
-			$upgrade{$1}{from} = $1;
-			$upgrade{$1}{to} = $2;
-		}
-	}
-}
-
-print "\nREADY TO BEGIN UPGRADES\n" unless ($quiet);
-
-my $notRun = 1;
-
-
-my $currentPath  = Cwd::getcwd();
-my $totalConfigs = scalar keys %config;
-my $configCounter = 0;
-foreach my $filename (keys %config) {
-    chdir($upgradesPath);
-	my $clicmd = $config{$filename}{mysqlCLI} || $mysql;
-	my $dumpcmd = $config{$filename}{mysqlDump} || $mysqldump;
-	my $backupTo = $config{$filename}{backupPath} || $backupDir;
-	mkdir($backupTo);
-    ++$configCounter;
-	while ($upgrade{$config{$filename}{version}}{sql} ne "" || $upgrade{$config{$filename}{version}}{pl} ne "") {
-		my $upgrade = $upgrade{$config{$filename}{version}}{from};
-		print "\n".$config{$filename}{db}." ".$upgrade{$upgrade}{from}."-".$upgrade{$upgrade}{to}."\n" unless ($quiet);
-        print "Processing $configCounter out of $totalConfigs configs\n" unless ($quiet);
-		unless ($skipBackup) {
-			print "\tBacking up $config{$filename}{db} ($upgrade{$upgrade}{from})..." unless ($quiet);
-			my $cmd = qq!$dumpcmd -u"$config{$filename}{dbuser}" -p"$config{$filename}{dbpass}"!;
-			$cmd .= " --host=".$config{$filename}{host} if ($config{$filename}{host});
-			$cmd .= " --port=".$config{$filename}{port} if ($config{$filename}{port});
-			$cmd .= " --add-drop-table ".$config{$filename}{db}." --result-file="
-				.File::Spec->catfile($backupTo, $config{$filename}{db}."_".$upgrade{$upgrade}{from}."_".time.".sql");
-			unless (system($cmd)) {
-				print "OK\n" unless ($quiet);
-			} else {
-				print "Failed!\n" unless ($quiet);
-				fatalError();
-			}
-		}
-		if ($upgrade{$upgrade}{sql} ne "") {
-			print "\tUpgrading to ".$upgrade{$upgrade}{to}."..." unless ($quiet);
-			my $cmd = qq!$clicmd -u"$config{$filename}{dbuser}" -p"$config{$filename}{dbpass}"!;
-			$cmd .= " --host=".$config{$filename}{host} if ($config{$filename}{host});
-			$cmd .= " --port=".$config{$filename}{port} if ($config{$filename}{port});
-			$cmd .= " --database=".$config{$filename}{db}." < ".$upgrade{$upgrade}{sql};
-			unless (system($cmd)) {
-				print "OK\n" unless ($quiet);
-			} else {
-                		print "Failed!\n" unless ($quiet);
-				fatalError();
-                	}
-		}
-		if ($upgrade{$upgrade}{pl} ne "") {
-            my $pid = fork;
-            if (!$pid) {
-                local @ARGV = ("--configFile=$filename", $quiet ? ('--quiet') : ());
-                local $0 = $upgrade{$upgrade}{pl};
-                local $@;
-                do $0;
-                if ($@) {
-                    warn $@;
-                    exit 255;
-                };
-                exit;
-            }
-            waitpid $pid, 0;
-            if ($?) {
-                print "\tProcessing upgrade executable failed!\n";
-                fatalError();
-            }
-            ##Do a dummy load of the config
-            WebGUI::Config->clearCache();
-		}
-		$config{$filename}{version} = $upgrade{$upgrade}{to};
-		$notRun = 0;
-        sleep 1; # Sleep a second to avoid adding asset revisions too quickly
-	}
-    chdir($currentPath);
-	my $session = WebGUI::Session->open($filename);
-	print "\tSetting site upgrade completed..." unless ($quiet);
-	$session->setting->remove('specialState');
-	$session->close();
-	print "OK\n" unless ($quiet);
-}
-
-if ($notRun) {
-	print "\nNO UPGRADES NECESSARY\n\n" unless ($quiet);
-} else {
-	unless ($quiet) {
-		print <<STOP;
-
-UPGRADES COMPLETE
+Upgrades complete.
 Please restart your web server and test your sites.
 
-WARNING: If you saw any errors in the output during the upgrade, restore 
-your install and databases from backup immediately. Do not continue using 
-your site EVEN IF IT SEEMS TO WORK.
-
-NOTE: If you have not already done so, please consult
-docs/gotcha.txt for possible upgrade complications.
-
 STOP
-	}
-}
-
-
-
-
-#-----------------------------------------
-# checkVersion($versionNumber)
-#-----------------------------------------
-# Version number must be 7.3.22 or greater
-# in order to be upgraded by this utility.
-#-----------------------------------------
-sub checkVersion {
-    $_[0] =~ /(\d+)\.(\d+)\.(\d+)/;
-    my $goal = 7;
-    my $feature = 3;
-    my $fix = 22;
-    if ($1 > $goal) {
-        return 1;
-    }
-    elsif ($1 == $goal) {
-        if ($2 > $feature) {
-            return 1;
-        }
-        elsif ($2 == $feature) {
-            if ($3 >= $fix) {
-                return 1;
-            }
-        }
-    }
-    return 0;
-}
-
-#-----------------------------------------
-sub fatalError {
-	print <<STOP;
-
-The upgrade process failed and has stopped so you can either restore
-from backup, or attempt to fix the problem and continue.
-
-STOP
-    exit 1;
-}
-
-
-#-----------------------------------------
-sub _parseDSN {
-    my($dsn, $args) = @_;
-    my($var, $val, $hash);
-    $hash = {};
-
-    if (!defined($dsn)) {
-        return;
-    }
-
-    $dsn =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i
-                        or '' =~ /()/; # ensure $1 etc are empty if match fails
-    $hash->{driver} = $1;
-
-    while (length($dsn)) {
-        if ($dsn =~ /([^:;]*)[:;](.*)/) {
-            $val = $1;
-            $dsn = $2;
-        } else {
-            $val = $dsn;
-            $dsn = '';
-        }
-        if ($val =~ /([^=]*)=(.*)/) {
-            $var = $1;
-            $val = $2;
-            if ($var eq 'hostname'  ||  $var eq 'host') {
-                $hash->{'host'} = $val;
-            } elsif ($var eq 'db'  ||  $var eq 'dbname') {
-                $hash->{'database'} = $val;
-            } else {
-                $hash->{$var} = $val;
-            }
-        } else {
-            foreach $var (@$args) {
-                if (!defined($hash->{$var})) {
-                    $hash->{$var} = $val;
-                    last;
-                }
-            }
-        }
-
-     }
-     return $hash;
-}
-
-sub readLines {
-    my $file = shift;
-    my @lines;
-    if (open(my $fh, '<', $file)) {
-        while (my $line = <$fh>) {
-            $line =~ s/#.*//;
-            $line =~ s/^\s+//;
-            $line =~ s/\s+$//;
-            next if !$line;
-            push @lines, $line;
-        }
-        close $fh;
-    }
-    return @lines;
-}
 
 __END__
 
@@ -392,34 +114,33 @@ upgrade - Upgrade WebGUI database to the latest revision.
 
 =head1 SYNOPSIS
 
- upgrade --doit
-         [--backupDir path]
-         [--history]
-         [--mysql pathname]
-         [--mysqldump pathname]
-         [--override]
-         [--skipBackup]
-         [--skipDelete]
-         [--skipMaintenance]
-         [--quiet]
+    upgrade --doit
+            [--backupDir path]
+            [--mysql pathname]
+            [--mysqldump pathname]
+            [--override]
+            [--skipBackup]
+            [--skipDelete]
+            [--skipMaintenance]
+            [--quiet]
+    upgrade --history
 
- upgrade --help
+    upgrade --help
 
 =head1 DESCRIPTION
 
 This WebGUI utility script is able to upgrade B<any> WebGUI database
-from 7.3.22 upward to the currently installed version. The WebGUI
-software distribution includes a set of upgrade scripts that
-perform the necessary database changes (schema and data) to bring
-the database up-to-date in order to match the currently installed
-WebGUI libraries and programs.
+to the currently installed version. The WebGUI software distribution
+includes a set of upgrade scripts that perform the necessary database
+changes (schema and data) to bring the database up-to-date in order
+to match the currently installed WebGUI libraries and programs.
 
 This utility is designed to be run as a superuser on Linux systems,
 since it needs to be able to access several system directories
 and change ownership of files. If you want to run this utility without
-superuser privileges, use the B<--override> option described below.
+superuser privileges, use the C<--override> option described below.
 
-=head1 WARNING
+=head2 WARNING
 
 There are B<NO> guarantees of any kind provided with this software.
 This utility has been tested rigorously, and has performed without
@@ -431,62 +152,64 @@ B<BEFORE YOU UPGRADE> you should definitely read docs/gotcha.txt to
 find out what things you should know about that will affect your
 upgrade.
 
-=over
+=head1 OPTIONS
 
-=item B<--doit>
+=over 4
+
+=item C<--doit>
 
 You B<MUST> include this flag in the command line or the script
 will refuse to run. This is to force you to read this documentation
 at least once and be sure that you B<REALLY> want to perform the
 upgrade.
 
-=item B<--backupDir path>
+=item C<--backupDir path>
 
 Specify a path where database backups should be created during the
-upgrade procedure. If left unspecified, it defaults to B</tmp/backups>.
+upgrade procedure. If left unspecified, it defaults to C</tmp/backups>.
 
-=item B<--history>
+=item C<--history>
 
 Displays the upgrade history for each of your sites. Running with this
 flag will B<NOT> perform the upgrade.
 
-=item B<--mysql pathname>
+=item C<--mysql pathname>
 
 The full pathname to your mysql client executable. If left unspecified,
-it defaults to B</usr/bin/mysql>.
+it defaults to C</usr/bin/mysql>.
 
-=item B<--mysqldump pathname>
+=item C<--mysqldump pathname>
 
 The full pathname to your mysqldump executable. If left unspecified,
-it defaults to B</usr/bin/mysqldump>.
+it defaults to C</usr/bin/mysqldump>.
 
-=item B<--override>
+=item C<--override>
 
 This flag will allow you to run this utility without being the super user,
 but note that it may not work as intended.
 
-=item B<--skipBackup>
+=item C<--skipBackup>
 
 Use this if you B<DO NOT> want database backups to be performed
 during the upgrade procedure.
 
-=item B<--skipDelete>
+=item C<--skipDelete>
 
 The upgrade procedure normally deletes WebGUI's cache and temporary files
 created as part of the upgrade. This cleanup is very important during
 large upgrades, but can make the procedure quite slow. This option
 skips the deletion of these files.
 
-=item B<--skipMaintenance>
+=item C<--skipMaintenance>
 
 The upgrade procedure normally puts up a simple maintenance page on all
 the sites while running, but this option will skip that step.
 
-=item B<--quiet>
+=item C<--quiet>
 
 Disable all output unless there's an error.
 
-=item B<--help>
+=item C<--help>
 
 Shows this documentation, then exits.
 

share/site.psgi

@@ -29,8 +29,11 @@ builder {
 
     enable '+WebGUI::Middleware::HTTPExceptions';
 
+    enable 'ErrorDocument', 503 => $config->get('maintenancePage');
     enable_if { ! $_[0]->{'webgui.debug'} } 'ErrorDocument', 500 => $config->get('maintenancePage');
 
+    enable '+WebGUI::Middleware::Maintenance';
+
     enable_if { $_[0]->{'webgui.debug'} } 'StackTrace';
     enable_if { $_[0]->{'webgui.debug'} } 'Debug', panels => [
         'Environment',

share/upgrades/7.9.8-8.0.0/addMaintenancePageToConfig.pl

@@ -0,0 +1,14 @@
+use WebGUI::Upgrade::Script;
+
+use File::Basename;
+use Cwd qw(realpath);
+use File::Spec::Functions;
+use WebGUI::Paths;
+
+start_step "Moving preload files";
+
+my $webgui_root = realpath( catdir( dirname( $INC{'WebGUI/Upgrade/Script.pm'} ), (updir) x 3 ) );
+
+config->set('maintenancePage', catfile( $webgui_root, 'www', 'maintenance.html' ));
+
+done;