From fa471df450acd586b466f58ef7a52c38061caaa0 Mon Sep 17 00:00:00 2001 From: Paul Driver Date: Tue, 26 Oct 2010 14:23:28 -0700 Subject: [PATCH] Story Archive now plays nice with urlExtensions --- docs/gotcha.txt | 5 +++++ lib/WebGUI/Asset/Wobject/StoryArchive.pm | 11 ++++++++--- sbin/testEnvironment.pl | 1 + t/Asset/Wobject/StoryArchive.t | 24 ++++++++++++++++++------ t/lib/WebGUI/Test.pm | 19 +++++++++++++++++++ 5 files changed, 51 insertions(+), 9 deletions(-) diff --git a/docs/gotcha.txt b/docs/gotcha.txt index 2bde77c2e..5d2e30cd0 100644 --- a/docs/gotcha.txt +++ b/docs/gotcha.txt @@ -7,6 +7,11 @@ 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. +7.10.4 +-------------------------------------------------------------------- + * WebGUI now depends on Monkey::Patch for doing sanely scoped + monkeypatches. + 7.10.3 -------------------------------------------------------------------- * In the Collaboration System, previously the Group to Post group diff --git a/lib/WebGUI/Asset/Wobject/StoryArchive.pm b/lib/WebGUI/Asset/Wobject/StoryArchive.pm index 5d65cce03..d5f096169 100644 --- a/lib/WebGUI/Asset/Wobject/StoryArchive.pm +++ b/lib/WebGUI/Asset/Wobject/StoryArchive.pm @@ -367,9 +367,14 @@ Constructs a url for a subfolder with the given name. sub getFolderUrl { my ($self, $name) = @_; - my $base = $self->getUrl; - $base =~ s/(.*)\..*/$1/; - return "$base/$name"; + my $session = $self->session; + my $base = $self->getUrl; + $base =~ s/(.*)\..*/$1/; + my $url = "$base/$name"; + if (my $ext = $session->setting->get('urlExtension')) { + $url .= ".$ext"; + } + return $session->url->urlize($url); } #------------------------------------------------------------------- diff --git a/sbin/testEnvironment.pl b/sbin/testEnvironment.pl index 7d2bf05f5..49d17bc52 100755 --- a/sbin/testEnvironment.pl +++ b/sbin/testEnvironment.pl @@ -148,6 +148,7 @@ checkModule("CHI", "0.34" ); checkModule('IO::Socket::SSL', ); checkModule('Net::Twitter', "3.13006" ); checkModule('PerlIO::eol', "0.14" ); +checkModule('Monkey::Patch', '0.03' ); failAndExit("Required modules are missing, running no more checks.") if $missingModule; diff --git a/t/Asset/Wobject/StoryArchive.t b/t/Asset/Wobject/StoryArchive.t index 67a0704d9..8f98f6f5b 100644 --- a/t/Asset/Wobject/StoryArchive.t +++ b/t/Asset/Wobject/StoryArchive.t @@ -63,7 +63,7 @@ $canPostMaker->prepare({ fail => [1, $reader ], }); -my $tests = 54 +my $tests = 56 + $canPostMaker->plan ; plan tests => 1 @@ -133,22 +133,34 @@ my $folderName = $dt->strftime('%B_%d_%Y'); $folderName =~ s/^(\w+_)0/$1/; is($todayFolder->getTitle, $folderName, '... folder has the right name'); my $folderUrl = $archive->getFolderUrl($folderName); -is($todayFolder->getUrl, $folderUrl, '... folder has the right URL'); +is($todayFolder->get('url'), $folderUrl, '... folder has the right URL'); is($todayFolder->getParent->getId, $archive->getId, '... created folder has the right parent'); is($todayFolder->get('state'), 'published', '... created folder is published'); is($todayFolder->get('status'), 'approved', '... created folder is approved'); is($todayFolder->get('styleTemplateId'), $archive->get('styleTemplateId'), '... created folder has correct styleTemplateId'); { + my $undo = WebGUI::Test->overrideSetting(urlExtension => 'ext'); my $arch2 = $home->addChild({ className => $class, - url => 'home/extension-tester.ext', title => 'Extension Tester', }); addToCleanup($arch2); - ok defined $arch2->getFolder($now), 'getFolder with url extension'; - is $arch2->getFolderUrl('blah'), '/home/extension-tester/blah', - 'folder urls have extension properly stripped'; + + is $arch2->get('url'), + 'home/extension-tester.ext', + 'ext added'; + + is $arch2->getFolderUrl('blah'), + 'home/extension-tester/blah.ext', + 'folder url: strip extension from parent and add to child'; + + my $folder = $arch2->getFolder($now); + ok defined $folder, 'getFolder with url extension'; + + is $folder->get('url'), + $arch2->getFolderUrl($folder->getMenuTitle), + 'getFolderUrl and folder getUrl match'; } my $sameFolder = $archive->getFolder($now); diff --git a/t/lib/WebGUI/Test.pm b/t/lib/WebGUI/Test.pm index 3f87eda9c..8dbbcc2a0 100644 --- a/t/lib/WebGUI/Test.pm +++ b/t/lib/WebGUI/Test.pm @@ -39,6 +39,7 @@ use Scalar::Util qw( blessed ); use List::MoreUtils qw( any ); use Carp qw( carp croak ); use JSON qw( from_json to_json ); +use Monkey::Patch qw( patch_object ); use Scope::Guard; BEGIN { @@ -687,6 +688,24 @@ sub getMailFromQueue { #---------------------------------------------------------------------------- +=head2 overrideSetting (name, val) + +Overrides WebGUI::Test->session->setting->get($name) to return $val until the +handle this method returns goes out of scope. + +=cut + +sub overrideSetting { + my ($class, $name, $val) = @_; + patch_object $class->session->setting => get => sub { + my $get = shift; + return $val if $_[1] eq $name; + goto &$get; + }; +} + +#---------------------------------------------------------------------------- + =head2 cleanupAdminInbox ( ) Push a list of Asset objects onto the stack of assets to be automatically purged