Merge branch 'master' of git@github.com:plainblack/webgui

Conflicts:
	docs/changelog/7.x.x.txt
	docs/upgrades/upgrade_7.7.19-7.8.0.pl

t/Asset/Asset.t

@@ -153,7 +153,7 @@ $canViewMaker->prepare(
     },
 );
 
-plan tests => 113 
+plan tests => 115 
             + scalar(@fixIdTests)
             + scalar(@fixTitleTests)
             + 2*scalar(@getTitleTests) #same tests used for getTitle and getMenuTitle
@@ -874,6 +874,20 @@ is($testVersionTag->get('isCommitted'),1,'parent asset is now committed');
 $childVersionTag = WebGUI::VersionTag->new($session, $childAsset->get('tagId'));
 is($childVersionTag->get('isCommitted'),1,'child asset is now committed');
 
+################################################################
+#
+# cloneFromDb
+#
+################################################################
+
+my $assetToCommit = $defaultAsset->addChild({ className => 'WebGUI::Asset::Snippet', title => 'Snippet to commit and clone from db', });
+my $cloneTag = WebGUI::VersionTag->getWorking($session);
+WebGUI::Test->tagsToRollback($cloneTag);
+$cloneTag->commit;
+is($assetToCommit->get('status'), 'pending', 'cloneFromDb: local asset is still pending');
+$assetToCommit = $assetToCommit->cloneFromDb;
+is($assetToCommit->get('status'), 'approved', '... returns fresh, commited asset from the db');
+
 ##Return an array of hashrefs.  Each hashref describes a test
 ##for the fixId method.
 

t/Asset/Event/edit.t

@@ -74,9 +74,8 @@ if ( !$mech->success ) {
     plan skip_all => "Cannot load URL '$baseUrl'. Will not test.";
 }
 
-if ( !$ENV{WEBGUI_LIVE}) {
-    plan skip_all => "Live tests not enabled";
-}
+plan skip_all => 'set WEBGUI_LIVE to enable this test'
+    unless $ENV{WEBGUI_LIVE};
 
 plan tests => 8;        # Increment this number for each test you create
 

t/Form/DynamicField.t

@@ -0,0 +1,40 @@
+#-------------------------------------------------------------------
+# 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
+#-------------------------------------------------------------------
+
+use FindBin;
+use strict;
+use lib "$FindBin::Bin/../lib";
+
+use WebGUI::Test;
+use WebGUI::Form;
+use WebGUI::Form::FieldType;
+use WebGUI::Session;
+
+#The goal of this test is to verify that Email form elements work.
+#The Email form accepts and validates an email address.
+
+use Test::More; # increment this value for each test you create
+
+my $session = WebGUI::Test->session;
+
+# put your tests here
+
+my $formClass = 'WebGUI::Form::DynamicField';
+
+my $numTests = 1;
+
+plan tests => $numTests;
+
+my $form = WebGUI::Form::DynamicField->new($session,
+    fieldType => 'FormTest',
+);
+
+diag "Test loading a Form from a location outside of /data/WebGUI/lib/WebGUI";
+isa_ok($form, 'WebGUI::Form::FormTest');

t/Workflow/Activity/CalendarUpdateFeeds.t

@@ -22,12 +22,10 @@ use Test::More;
 use Test::Deep;
 use Data::Dumper;
 
-if (!$ENV{WEBGUI_LIVE}) {
-    plan skip_all => 'No website available';
-}
-else {
-    plan tests => 14; # increment this value for each test you create
-}
+plan skip_all => 'set WEBGUI_LIVE to enable this test'
+    unless $ENV{WEBGUI_LIVE};
+
+plan tests => 14; # increment this value for each test you create
 
 my $session = WebGUI::Test->session;
 

t/Workflow/Activity/GetCsMail.t

@@ -102,9 +102,7 @@ $post2mock->set_always('getId', $post2_id);
 
 {
     # simulate asset not found
-    local *WebGUI::Asset::newByDynamicClass = sub {
-        return undef;
-    };
+    WebGUI::Test->mockAssetId($post2_id, undef);
     $getmock->set_series('getNextMessage', {
         from => 'admin@localhost',
         parts => ['parts'],
@@ -114,12 +112,11 @@ $post2mock->set_always('getId', $post2_id);
     });
     $activity->execute($csmock);
     is $parentAsset->getId, $cs_id, 'add as new thread to current cs if reply to nonexistant post';
+    WebGUI::Test->unmockAssetId($post2_id);
 }
 
 {
-    local *WebGUI::Asset::newByDynamicClass = sub {
-        return $post2mock;
-    };
+    WebGUI::Test->mockAssetId($post2_id, $post2mock);
     $getmock->set_series('getNextMessage', {
         from => 'admin@localhost',
         parts => ['parts'],
@@ -129,12 +126,11 @@ $post2mock->set_always('getId', $post2_id);
     });
     $activity->execute($csmock);
     is $parentAsset->getId, $cs_id, 'add as new thread to current cs if reply to post in another CS';
+    WebGUI::Test->unmockAssetId($post2_id);
 }
 
 {
-    local *WebGUI::Asset::newByDynamicClass = sub {
-        return $postmock;
-    };
+    WebGUI::Test->mockAssetId($post_id, $postmock);
     $getmock->set_series('getNextMessage', {
         from => 'admin@localhost',
         parts => ['parts'],
@@ -144,6 +140,7 @@ $post2mock->set_always('getId', $post2_id);
     });
     $activity->execute($csmock);
     is $parentAsset->getId, $post_id, 'add as reply to post if reply to post in current CS';
+    WebGUI::Test->unmockAssetId($post_id);
 }
 
 #----------------------------------------------------------------------------

t/Workflow/Instance.t

@@ -17,6 +17,8 @@ use strict;
 use lib "$FindBin::Bin/../lib";
 use Test::More;
 use Test::Deep;
+use Test::Exception;
+use Scope::Guard;
 
 use Test::MockObject;
 my $mockSpectre = Test::MockObject->new();
@@ -46,7 +48,7 @@ my $session         = WebGUI::Test->session;
 #----------------------------------------------------------------------------
 # Tests
 
-plan tests => 32;        # Increment this number for each test you create
+plan tests => 34;        # Increment this number for each test you create
 
 #----------------------------------------------------------------------------
 # put your tests here
@@ -181,6 +183,46 @@ my $wf2 = WebGUI::Workflow->create(
 my $wf2Instance = WebGUI::Workflow::Instance->create($session, {workflowId => $wf2->getId});
 cmp_deeply($wf2Instance->get('parameters'), {}, 'get returns {} for parameters when there are no parameters stored');
 
+###############################################################################
+#
+#  getObject
+#
+###############################################################################
+
+{
+    my $return;
+    Test::MockObject->fake_module('WebGUI::Test::Workflow::Instance::TestObject',
+        new => sub {
+            return $return;
+        },
+    );
+
+    my $wf3 = WebGUI::Workflow->create(
+        $session,
+        {
+            title => 'WebGUI::Workflow::Instance Test',
+            description => 'getObject test',
+            type => 'WebGUI::Test::Workflow::Instance::TestObject',
+        }
+    );
+    my $wf3guard = Scope::Guard->new(sub {
+        $wf3->delete;
+    });
+
+    my $wf3Instance = WebGUI::Workflow::Instance->create( $session, {
+        workflowId => $wf3->getId,
+        className  => 'WebGUI::Test::Workflow::Instance::TestObject',
+        methodName => 'new',
+    });
+
+    dies_ok { $wf3Instance->getObject } 'getObject throws when instanciation returns undef';
+
+    $return = Test::MockObject->new;
+    lives_and {
+        is $wf3Instance->getObject, $return;
+    } 'getObject is able to retrieve correct object';
+}
+
 #----------------------------------------------------------------------------
 # Cleanup
 END {

t/lib/WebGUI/Form/FormTest.pm

@@ -0,0 +1,52 @@
+package WebGUI::Form::FormTest;
+
+=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 base 'WebGUI::Form::Control';
+use WebGUI::International;
+
+=head1 NAME
+
+Package WebGUI::Form::FormTest
+
+=head1 DESCRIPTION
+
+Dummy Form plugin for testing dynamic loading of Forms from other locations.
+
+=head1 SEE ALSO
+
+This is a subclass of WebGUI::Form::Control.
+
+=head1 METHODS 
+
+The following methods are specifically available from this class. Check the superclass for additional methods.
+
+=cut
+
+#-------------------------------------------------------------------
+
+=head2 getName ( session )
+
+Returns the human readable name of this control.
+
+=cut
+
+sub getName {
+    my ($self, $session) = @_;
+    return 'FormTest';
+}
+
+1;

t/lib/WebGUI/Test.pm

@@ -126,6 +126,24 @@ BEGIN {
 
     push (@INC,$WEBGUI_LIB);
 
+    ##Handle custom loaded library paths
+    warn $WEBGUI_ROOT;
+    my $customPreload = File::Spec->catdir( $WEBGUI_ROOT, 'sbin', 'preload.custom');
+    warn $customPreload;
+    if (-e $customPreload) {
+        open my $PRELOAD, '<', $customPreload or
+            croak "Unload to open $customPreload: $!\n";
+        LINE: while (my $line = <$PRELOAD>) {
+            $line =~ s/#.*//;
+            $line =~ s/^\s+//;
+            $line =~ s/\s+$//;
+            next LINE if !$line;
+            warn $line;
+            push @INC, $line;
+        }
+        close $PRELOAD;
+    }
+
     # http://thread.gmane.org/gmane.comp.apache.apreq/3378
     # http://article.gmane.org/gmane.comp.apache.apreq/3388
     if ( $^O eq 'darwin' && $Config::Config{osvers} lt '8.0.0' ) {
@@ -246,6 +264,100 @@ END {
     }
 }
 
+=head2 mockAssetId ( $assetId, $object )
+
+Causes WebGUI::Asset->new* initializers to return the specified
+object instead of retreiving it from the database for the given
+asset ID.
+
+=cut
+
+my %mockedAssetIds;
+sub mockAssetId {
+    my ($class, $assetId, $object) = @_;
+    _mockAssetInits();
+    $mockedAssetIds{$assetId} = $object;
+}
+
+=head2 unmockAssetId ( $assetId )
+
+Removes a given asset ID from being mocked.
+
+=cut
+
+sub unmockAssetId {
+    my ($class, $assetId) = @_;
+    delete $mockedAssetIds{$assetId};
+}
+
+=head2 mockAssetUrl ( $url, $object )
+
+Causes WebGUI::Asset->newByUrl to return the specified object instead
+of retreiving it from the database for the given URL.
+
+=cut
+
+my %mockedAssetUrls;
+sub mockAssetUrl {
+    my ($url, $object) = @_;
+    _mockAssetInits();
+    $mockedAssetUrls{$url} = $object;
+}
+
+=head2 unmockAssetUrl ( $url )
+
+Removes a given asset URL from being mocked.
+
+=cut
+
+sub unmockAssetUrl {
+    my ($class, $url) = @_;
+    delete $mockedAssetUrls{$url};
+}
+
+my $mockedNew;
+sub _mockAssetInits {
+    no warnings 'redefine';
+
+    return
+        if $mockedNew;
+    require WebGUI::Asset;
+    my $original_new = \&WebGUI::Asset::new;
+    *WebGUI::Asset::new = sub {
+        my ($class, $session, $assetId, $className, $revisionDate) = @_;
+        if ($mockedAssetIds{$assetId}) {
+            return $mockedAssetIds{$assetId};
+        }
+        goto $original_new;
+    };
+    my $original_newByDynamicClass = \&WebGUI::Asset::newByDynamicClass;
+    *WebGUI::Asset::newByDynamicClass = sub {
+        my ($class, $session, $assetId, $revisionDate) = @_;
+        if ($mockedAssetIds{$assetId}) {
+            return $mockedAssetIds{$assetId};
+        }
+        goto $original_newByDynamicClass;
+    };
+    my $original_newPending = \&WebGUI::Asset::newPending;
+    *WebGUI::Asset::newPending = sub {
+        my ($class, $session, $assetId, $revisionDate) = @_;
+        if ($mockedAssetIds{$assetId}) {
+            return $mockedAssetIds{$assetId};
+        }
+        goto $original_newPending;
+    };
+    my $original_newByUrl = \&WebGUI::Asset::newByUrl;
+    *WebGUI::Asset::newByUrl = sub {
+        my ($class, $session, $url, $revisionDate) = @_;
+        if ($mockedAssetUrls{$url}) {
+            return $mockedAssetUrls{$url};
+        }
+        goto $original_newByUrl;
+    };
+
+    $mockedNew = 1;
+}
+
 #----------------------------------------------------------------------------
 
 =head2 interceptLogging