Merge commit 'v7.10.18' into 8

Conflicts:
	docs/gotcha.txt
	docs/previousVersion.sql
	docs/templates.txt
	lib/WebGUI.pm
	lib/WebGUI/Asset/File.pm
	lib/WebGUI/Asset/Story.pm
	lib/WebGUI/Asset/Wobject/Calendar.pm
	lib/WebGUI/Asset/Wobject/Thingy.pm
	lib/WebGUI/AssetExportHtml.pm
	lib/WebGUI/Content/AssetManager.pm
	lib/WebGUI/Group.pm
	lib/WebGUI/Macro/AssetProxy.pm
	lib/WebGUI/Shop/PayDriver/PayPal/PayPalStd.pm
	lib/WebGUI/Storage.pm
	t/Asset/AssetExportHtml.t
	t/Asset/Story.t
	t/Shop/TaxDriver/Generic.t
	t/Storage.t
This commit is contained in:
Doug Bell 2011-06-21 16:03:49 -05:00
commit 0c5acb697b
75 changed files with 979 additions and 139 deletions

View file

@ -882,6 +882,7 @@ sub getTitleTests {
subtest 'canAdd tolerates being called as an object method', sub {
my $class = 'WebGUI::Asset::Snippet';
my $snip = $tempNode->addChild({className => $class});
WebGUI::Test->addToCleanup($snip);
# Make a test user who's just in Turn Admin On
my $u = WebGUI::User->create($session);

View file

@ -20,6 +20,7 @@ use WebGUI::Test; # Must use this before any other WebGUI modules
use WebGUI::Session;
use WebGUI::Asset;
use WebGUI::Exception;
use WebGUI::Test::Event;
use Cwd;
use Exception::Class;
@ -36,7 +37,27 @@ my $session = WebGUI::Test->session;
#----------------------------------------------------------------------------
# Tests
plan tests => 128; # Increment this number for each test you create
WebGUI::Test->originalConfig('exportPath');
my @events;
my $testRan = 1;
plan tests => 125; # Increment this number for each test you create
sub export_ok {
my ($asset, $message) = @_;
subtest $message => sub {
plan tests => 3;
my $e;
my @events = trap {
eval { $asset->exportWriteFile() };
$e = $@;
} $asset->session, 'asset::export';
ok !$e, 'ran without exception';
is scalar @events, 1, 'event fired once';
is $events[0][2], $asset->exportGetUrlAsPath->absolute;
};
}
#----------------------------------------------------------------------------
# exportCheckPath()
@ -385,11 +406,7 @@ my $content;
my $guid = $session->id->generate;
my $guidPath = Path::Class::Dir->new($config->get('uploadsPath'), 'temp', $guid);
$config->set('exportPath', $guidPath->absolute->stringify);
eval { $parent->exportWriteFile() };
is($@, '', "exportWriteFile works when creating exportPath");
# ensure that the file was actually written
ok(-e $parent->exportGetUrlAsPath->absolute->stringify, "exportWriteFile actually writes the file when creating exportPath");
export_ok $parent, 'exportWriteFile works when creating exportPath';
# now make sure that it contains the correct content
$content = WebGUI::Test->getPage2(
@ -444,7 +461,7 @@ eval { $firstChild->exportWriteFile() };
is($@, '', "exportWriteFile works for first_child");
# ensure that the file was actually written
ok(-e $firstChild->exportGetUrlAsPath->absolute->stringify, "exportWriteFile actually writes the first_child file");
export_ok $firstChild, 'exportWriteFile works for first_child';
# verify it has the correct contents
eval { $content = WebGUI::Test->getPage2( $firstChild->get('url').'?func=exportHtml_view', ) };
@ -456,11 +473,7 @@ $guidPath->rmtree;
$session->response->setNoHeader(1);
$session->user( { userId => 1 } );
eval { $grandChild->exportWriteFile() };
is($@, '', "exportWriteFile works for grandchild");
# ensure that the file was written
ok(-e $grandChild->exportGetUrlAsPath->absolute->stringify, "exportWriteFile actually writes the grandchild file");
export_ok $grandChild, 'exportWriteFile works for grandchild';
# finally, check its contents
$session->style->sent(0);
@ -471,17 +484,12 @@ is(scalar $grandChild->exportGetUrlAsPath->absolute->slurp, $content, "exportWri
$guidPath->rmtree;
$asset = WebGUI::Asset->newById($session, 'ExportTest000000000001');
$session->response->setNoHeader(1);
eval { $asset->exportWriteFile() };
is($@, '', 'exportWriteFile for perl file works');
ok(-e $asset->exportGetUrlAsPath->absolute->stringify, "exportWriteFile actually writes the perl file");
export_ok $asset, 'exportWriteFile for perl file works';
$guidPath->rmtree;
$asset = WebGUI::Asset->newById($session, 'ExportTest000000000002');
eval { $asset->exportWriteFile() };
is($@, '', 'exportWriteFile for plain file works');
ok(-e $asset->exportGetUrlAsPath->absolute->stringify, "exportWriteFile actuall writes the plain file");
$asset = WebGUI::Asset->new($session, 'ExportTest000000000002');
export_ok $asset, 'exportWriteFile for plain file works';
$guidPath->rmtree;
@ -492,8 +500,11 @@ $guidPath->rmtree;
# permissions on something.
$parent->update( { groupIdView => 3 } ); # admins
$session->response->setNoHeader(1);
eval { $parent->exportWriteFile() };
$e = Exception::Class->caught();
@events = trap {
eval { $parent->exportWriteFile() };
$e = Exception::Class->caught();
} $session, 'asset::export';
isa_ok($e, 'WebGUI::Error', "exportWriteFile throws when user can't view asset");
cmp_deeply(
$e,
@ -507,6 +518,7 @@ cmp_deeply(
# no directory or file written
ok(!-e $parent->exportGetUrlAsPath->absolute->stringify, "exportWriteFile doesn't write file when user can't view asset");
ok(!-e $parent->exportGetUrlAsPath->absolute->parent, "exportWriteFile doesn't write directory when user can't view asset");
is scalar @events, 0, 'event not fired';
# undo our viewing changes
$parent->update( { groupIdView => 7 } ); # everyone

View file

@ -270,6 +270,7 @@ subtest 'asset metadata versioning' => sub {
is $meta->get(), 'version one', 'v1 has not been changed';
my $dup = $asset->duplicate;
WebGUI::Test->addToCleanup($dup);
my $db = $session->db;
my $count_rev = sub {

View file

@ -41,10 +41,10 @@ my $map = $node->addChild({
# Create a map point
my $test_point = {
website => 'http://www.plainblack.com',
address1 => '520 University Ave',
address1 => '520 University',
address2 => 'Suite 320',
city => 'Madison',
region => 'WI',
region => 'Wisconsin',
zipCode => '53703',
country => 'United States',
phone => '608-555-1212',

View file

@ -0,0 +1,50 @@
# vim:syntax=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
#------------------------------------------------------------------
=head1 BUG DESCRIPTION
Thread's duplicate method fails if the subscriptionGroupId isn't a valid group
(for instance, if it was imported from another site). It should just not copy
the group in that case.
=cut
use warnings;
use strict;
use Test::More tests => 4;
use Test::Exception;
use FindBin;
use lib "$FindBin::Bin/../../../lib";
use WebGUI::Test;
use WebGUI::Asset;
my $session = WebGUI::Test->session;
my $collab = WebGUI::Test->asset( className => 'WebGUI::Asset::Wobject::Collaboration' );
my $thread = $collab->addChild(
{
className => 'WebGUI::Asset::Post::Thread',
subscriptionGroupId => $session->id->generate(),
}
);
WebGUI::Test->addToCleanup($thread);
SKIP: {
my $copy;
skip('duplicate died', 3) unless
lives_ok { $copy = $thread->duplicate() } q"duplicate() doesn't die";
WebGUI::Test->addToCleanup($copy);
my $groupId = $copy->get('subscriptionGroupId');
ok $groupId, 'Copy has a group id';
isnt $groupId, $thread->get('subscriptionGroupId'), '...a different one';
ok(WebGUI::Group->new($session, $groupId), '...and it instantiates');
};

View file

@ -26,6 +26,10 @@ my %tag = ( tagId => $versionTag->getId, status => "pending" );
addToCleanup($versionTag);
my $snippet = $node->addChild({className=>'WebGUI::Asset::Snippet', %tag});
# Make sure TemplateToolkit is in the config file
WebGUI::Test->originalConfig( 'templateParsers' );
$session->config->addToArray( 'templateParsers' => 'WebGUI::Asset::Template::TemplateToolkit' );
# Test for a sane object type
isa_ok($snippet, 'WebGUI::Asset::Snippet');

View file

@ -8,6 +8,9 @@
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
use Test::MockTime qw/:all/;
use FindBin;
use strict;
use WebGUI::Test;
@ -77,8 +80,9 @@ WebGUI::Test->addToCleanup($storage1, $storage2);
#
############################################################
my $tests = 45;
plan tests => 1 + $tests
my $tests = 48;
plan tests => 1
+ $tests
+ $canEditMaker->plan
;
@ -459,4 +463,61 @@ cmp_bag(
) or diag Dumper( $keyword_loop );
$session->scratch->delete('isExporting');
############################################################
#
# addRevision, copying and duplicating photo data
#
############################################################
set_relative_time(-70);
my $rev_story = $archive->addChild({
className => 'WebGUI::Asset::Story',
title => 'Story revision',
subtitle => 'The story of a CMS',
byline => 'C.F. Kuskie',
story => 'Revisioning a story should not cause the photo information to be lost.',
}, undef, undef, { skipAutoCommitWorkflows => 1, skipNotification => 1, });
my $tag = WebGUI::VersionTag->getWorking($session);
$tag->commit;
my $rev_story = $rev_story->cloneFromDb;
my $rev_storage = WebGUI::Storage->create($session);
$rev_story->setPhotoData([{
byLine => 'C Forest Kuskie',
caption => 'ugly old hacker',
storageId => $rev_storage->getId,
}]);
cmp_deeply(
$rev_story->getPhotoData,
[{
byLine => 'C Forest Kuskie',
caption => 'ugly old hacker',
storageId => $rev_storage->getId,
}],
'setup for add revision test, photo data'
);
restore_time();
my $revision = $rev_story->addRevision({}, undef, undef, { skipAutoCommitWorkflows => 1, skipNotification => 1, });
cmp_deeply(
$revision->getPhotoData,
[{
byLine => 'C Forest Kuskie',
caption => 'ugly old hacker',
storageId => ignore(),
}],
'revision has a copy of most of the photo data'
);
my $revision_storageId = $revision->getPhotoData->[0]->{storageId};
ok($revision_storageId && ($revision_storageId ne $rev_storage->getId), 'storageId in the revision is different from the original');
#vim:ft=perl

View file

@ -55,7 +55,7 @@ use Data::Dumper;
use WebGUI::Asset::Wobject::Calendar;
use WebGUI::Asset::Event;
plan tests => 12 + scalar @icalWrapTests;
plan tests => 14 + scalar @icalWrapTests;
my $session = WebGUI::Test->session;
@ -314,8 +314,6 @@ addToCleanup($tag2);
is(scalar @{ $windowCal->getLineage(['children'])}, 17, 'added events to the window calendar');
diag "startDate: ". $windowStart->toDatabase;
diag "endDate: ". $windowEnd->toDatabase;
my @window = $windowCal->getEventsIn($windowStart->toDatabase, $windowEnd->toDatabase);
cmp_bag(
@ -590,3 +588,13 @@ cmp_deeply(
[],
'getFeeds: returns an empty array ref with no feeds'
);
##Update with JSON and try again :)
$feedCal->update({icalFeeds => '[]'});
is_deeply $feedCal->get('icalFeeds'), [], 'set as JSON, returned perl';
cmp_deeply(
$feedCal->getFeeds(),
[],
'but getFeeds still returns a data structure.'
);

View file

@ -101,7 +101,7 @@ cmp_deeply(
title => 'Dummy Title',
description => 'Dummy Synopsis', ##Not description
link => $session->url->getSiteURL . '/home/shawshank',
copyright => undef,
copyright => bool(0),
),
'... title, description, link inherit from asset by default, copyright unset'
);

70
t/Event.t Normal file
View file

@ -0,0 +1,70 @@
#-------------------------------------------------------------------
# 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 strict;
use warnings;
use FindBin;
use Test::More tests => 12;
use lib "$FindBin::Bin/lib";
use WebGUI::Test;
use WebGUI::Session;
use WebGUI::Event;
my $session = WebGUI::Test->session;
WebGUI::Test->originalConfig('events');
my $config = $session->config;
$config->set('events/foo', [
'My::Events::onFoo',
'My::Events::onFoo2'
]);
$config->set('events/bar', 'My::Events::onBar');
my ($foo, $foo2, $bar) = @_;
sub My::Events::onFoo {
my ($session, $name, $one, $two, $three) = @_;
isa_ok $session, 'WebGUI::Session', 'onFoo: session';
is $name, 'foo', "onFoo: $name";
$foo = $one;
}
sub My::Events::onFoo2 {
my ($session, $name, $one, $two, $three) = @_;
isa_ok $session, 'WebGUI::Session', 'onFoo2: session';
is $name, 'foo', "onFoo2: $name";
$foo2 = $two;
}
sub My::Events::onBar {
my ($session, $name, $one, $two, $three) = @_;
isa_ok $session, 'WebGUI::Session', 'onBar: session';
is $name, 'bar', "onBar: $name";
$bar = $three;
}
# Tell require that My::Events is already loaded.
$INC{'My/Events.pm'} = __FILE__;
fire $session, 'foo', qw(first second third);
is $foo, 'first', 'foo called';
is $foo2, 'second', 'foo2 called';
ok !defined $bar, 'bar not called';
undef $foo;
undef $foo2;
fire $session, 'bar', qw(first second third);
ok !defined $foo, 'foo not called';
ok !defined $foo2, 'foo2 not called';
is $bar, 'third', 'onBar called';
#vim:ft=perl

View file

@ -32,7 +32,7 @@ my $session = WebGUI::Test->session;
$templateMock->mock_id( $templateId );
$templateMock->mock_url( $templateUrl );
plan tests => 4;
plan tests => 6;
my $node = WebGUI::Test->asset;
my $thingy = $node->addChild({
@ -93,5 +93,17 @@ $templateProcessed = 0;
$output = WebGUI::Macro::RenderThingData::process($session, $thing_url, $templateUrl);
ok $templateProcessed, 'passed template url, template processed';
$templateProcessed = 0;
WebGUI::Test->originalConfig('gateway');
$session->config->set('gateway', '/gated');
my $thing_url = $thingy->getUrl('thingId='.$thingId.';thingDataId='.$thingDataId);
$output = WebGUI::Macro::RenderThingData::process($session, $thing_url, $templateId);
ok $templateProcessed, 'gateway set, passed templateId, template processed';
$templateProcessed = 0;
$output = WebGUI::Macro::RenderThingData::process($session, $thing_url, $templateUrl);
ok $templateProcessed, '... passed template url, template processed';
$templateProcessed = 0;

View file

@ -36,8 +36,8 @@ $session->user({userId => 3});
my $addExceptions = getAddExceptions($session);
plan tests => 79
+ 2*scalar(@{$addExceptions});
my $tests = 80 + 2*scalar(@{$addExceptions});
plan tests => $tests;
WebGUI::Test->addToCleanup(SQL => 'delete from tax_generic_rates');
@ -526,6 +526,20 @@ cmp_deeply(
'getTaxRates: return correct data for a state when the address has alternations'
);
my $capitalized = $taxer->add({
country => 'USA',
state => 'wi',
taxRate => '50',
});
cmp_deeply(
$taxer->getTaxRates($taxingAddress),
[0, 5, 0.5],
'... multiple entries with different capitalization, first matches'
);
$taxer->delete({ taxId => $capitalized });
#######################################################################
#
# calculate

View file

@ -11,6 +11,7 @@
use strict;
use WebGUI::Test;
use WebGUI::Test::Event;
use WebGUI::Session;
use WebGUI::Storage;
@ -29,7 +30,7 @@ my $cwd = Cwd::cwd();
my ($extensionTests, $fileIconTests, $block_extension_tests) = setupDataDrivenTests($session);
plan tests => 155
plan tests => 161
+ scalar @{ $extensionTests }
+ scalar @{ $fileIconTests }
+ scalar @{ $block_extension_tests }
@ -196,7 +197,16 @@ Hi, I'm a file.
I have two lines.
EOCON
my $filename = $storage1->addFileFromScalar('content', $content);
sub fired_ok(&@) {
my ($block, @expected) = @_;
my @events = trap { $block->() } $session, 'storage::addFile';
my @got = map { $_->[3] } @events;
cmp_bag \@got, \@expected, 'events fired for ' . join ', ', @expected;
}
my $filename; fired_ok {
$filename = $storage1->addFileFromScalar('content', $content)
} 'content';
is ($filename, 'content', 'processed filename returned by addFileFromScalar');
@ -236,10 +246,10 @@ foreach my $extTest (@{ $extensionTests }) {
my $fileStore = WebGUI::Storage->create($session);
WebGUI::Test->addToCleanup($fileStore);
cmp_bag($fileStore->getFiles(1), ['.'], 'Starting with an empty storage object, no files in here except for . ');
$fileStore->addFileFromScalar('.dotfile', 'dot file');
fired_ok { $fileStore->addFileFromScalar('.dotfile', 'dot file') } '.dotfile';
cmp_bag($fileStore->getFiles(), [ ], 'getFiles() by default does not return dot files');
cmp_bag($fileStore->getFiles(1), ['.', '.dotfile'], 'getFiles(1) returns all files, including dot files');
$fileStore->addFileFromScalar('dot.file', 'dot.file');
fired_ok { $fileStore->addFileFromScalar('dot.file', 'dot.file') } 'dot.file';
cmp_bag($fileStore->getFiles(), ['dot.file'], 'getFiles() returns normal files');
cmp_bag($fileStore->getFiles(1), ['.', '.dotfile', 'dot.file'], 'getFiles(1) returns all files, including dot files');
@ -260,7 +270,9 @@ is($obj->stringify, $storage1->getPath, '... Path::Class::Dir object has correct
####################################################
my $storageHash = {'blah'=>"blah",'foo'=>"foo"};
$storage1->addFileFromHashref("testfile-hash.file", $storageHash);
fired_ok {
$storage1->addFileFromHashref("testfile-hash.file", $storageHash);
} 'testfile-hash.file';
ok (-e $storage1->getPath("testfile-hash.file"), 'addFileFromHashRef creates file');
####################################################
@ -298,9 +310,11 @@ ok (!(-e $storage1->getPath("testfile-hash.file")), "rename file original file i
#
####################################################
$storage1->addFileFromFilesystem(
WebGUI::Test->getTestCollateralPath('littleTextFile'),
);
fired_ok {
$storage1->addFileFromFilesystem(
WebGUI::Test->getTestCollateralPath('littleTextFile'),
);
} 'littleTextFile';
ok(
grep(/littleTextFile/, @{ $storage1->getFiles }),
@ -334,7 +348,9 @@ cmp_bag($s3copy->getFiles(), [ @filesToCopy ], 'copy: passing explicit variable
my $deepDeepDir = $deepDir->subdir('deep');
my $errorStr;
my @foo = $deepDeepDir->mkpath({ error => \$errorStr } );
$deepStorage->addFileFromScalar('deep/file', 'deep file');
fired_ok {
$deepStorage->addFileFromScalar('deep/file', 'deep file')
} 'deep/file';
cmp_bag(
$deepStorage->getFiles('all'),
[ '.', 'deep', 'deep/file' ],

View file

@ -19,7 +19,7 @@ use WebGUI::User;
use WebGUI::ProfileField;
use WebGUI::Shop::AddressBook;
use Test::More tests => 233; # increment this value for each test you create
use Test::More tests => 235; # increment this value for each test you create
use Test::Deep;
use Data::Dumper;
@ -74,6 +74,7 @@ cmp_ok(abs($user->lastUpdated-$lastUpdate), '<=', 1, 'lastUpdated() -- status ch
$user->status('Selfdestructed');
is($user->status, "Selfdestructed", 'status("Selfdestructed")');
is($user->get('status'), "Selfdestructed", 'status("Selfdestructed") via get');
# Deactivation user deletes all sessions and scratches
@ -83,6 +84,7 @@ $newSession->scratch->set("hasStapler" => "no");
$user->status('Deactivated');
is($user->status, "Deactivated", 'status("Deactivated")');
is($user->get('status'), "Deactivated", 'status("Deactivated") via get');
ok(
!$session->db->quickScalar("SELECT COUNT(*) from userSession where userId=?",[$user->userId]),

32
t/_bug.skeleton Normal file
View file

@ -0,0 +1,32 @@
# vim:syntax=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
#------------------------------------------------------------------
=head1 BUG DESCRIPTION
Blah blah blah, whatever the bug poster said in the initial post plus any
relevant clarification from the discussion thread.
=cut
use warnings;
use strict;
use Test::More tests => 0;
use FindBin;
use lib "$FindBin::Bin/../lib";
use WebGUI::Test;
my $session = WebGUI::Test->session;
# A bug test should test the bug it is named for and be placed in an
# appropriate place in the test tree. For example, if bug #34721 was a Snippet
# bug, it would go in t/Asset/Snippet/bug_34721_short_description.t.

View file

@ -0,0 +1,78 @@
package WebGUI::Test::Event;
use List::Util qw(first);
use Exporter qw(import);
our @EXPORT = qw(trap);
=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 warnings;
=head1 SYNOPSIS
Temporarily handle WebGUI::Events.
=head1 METHODS
These methods are available from this class:
=cut
our $session;
our @names;
our @trap;
my $handlerName = __PACKAGE__ . '::handler';
sub handler {
my ($s, $n) = @_;
return unless first { $_ eq $n } @names;
push @trap, \@_;
};
#-------------------------------------------------------------------
=head2 trap ($code, $session, @names)
Traps the events named by @names and returns them as a list of arrayrefs in
the order they occured. The arrayrefs are all arguments passed to the event
handler.
=cut
sub trap(&$@) {
my $block = shift;
local ($session, @names) = @_;
local @trap;
my $config = $session->config;
my $events = $config->get('events');
local %WebGUI::Event::cache;
for my $name (@names) {
$config->set("events/$name", $handlerName);
}
eval { $block->() };
my $err = $@;
if ($events) {
$config->set(events => $events);
}
else {
$config->delete('events');
}
die $err if $err;
return @trap;
}