diff --git a/docs/changelog/7.x.x.txt b/docs/changelog/7.x.x.txt index 0744c59af..1d33f344f 100644 --- a/docs/changelog/7.x.x.txt +++ b/docs/changelog/7.x.x.txt @@ -1,4 +1,5 @@ 7.9.5 + - Asset->www_copy now has a progress bar - fixed #11556: New cart doesn't work with other forms on the same page - fixed #11557: Shop credit deduction calculated incorrectly - fixed #11561: PayDriver_Cash - password help diff --git a/lib/WebGUI/AssetClipboard.pm b/lib/WebGUI/AssetClipboard.pm index 194a37808..e8a693187 100644 --- a/lib/WebGUI/AssetClipboard.pm +++ b/lib/WebGUI/AssetClipboard.pm @@ -229,36 +229,98 @@ sub paste { =head2 www_copy ( ) -Duplicates self, cuts duplicate, returns self->getContainer->www_view if canEdit. Otherwise returns an AdminConsole rendered as insufficient privilege. +Duplicates self, cuts duplicate, returns self->getContainer->www_view if +canEdit. Otherwise returns an AdminConsole rendered as insufficient privilege. +If with children/descendants is selected, a progress bar will be rendered. =cut sub www_copy { - my $self = shift; - return $self->session->privilege->insufficient - unless $self->canEdit; + my $self = shift; + my $session = $self->session; + return $session->privilege->insufficient unless $self->canEdit; - - # with: 'children' || 'descendants' || '' - my $with = $self->session->form->get('with') || ''; - my $newAsset; - if ($with) { - my $childrenOnly = $with eq 'children'; - $newAsset = $self->duplicateBranch($childrenOnly); + my $with = $session->form->get('with'); + if ($with eq 'children') { + $self->_wwwCopyChildren; + } + elsif ($with eq 'descendants') { + $self->_wwwCopyDescendants; } else { - $newAsset = $self->duplicate({skipAutoCommitWorkflows => 1}); + $self->_wwwCopySingle; } - my $i18n = WebGUI::International->new($self->session, 'Asset'); - $newAsset->update({ title=>sprintf("%s (%s)",$self->getTitle,$i18n->get('copy'))}); +} + +#------------------------------------------------------------------- +sub _wwwCopyChildren { shift->_wwwCopyProgress(1) } + +#------------------------------------------------------------------- +sub _wwwCopyDescendants { shift->_wwwCopyProgress(0) } + +#------------------------------------------------------------------- +sub _wwwCopyFinish { + my ($self, $newAsset) = @_; + my $session = $self->session; + my $i18n = WebGUI::International->new($session, 'Asset'); + my $title = sprintf("%s (%s)", $self->getTitle, $i18n->get('copy')); + $newAsset->update({ title => $title }); $newAsset->cut; - if (WebGUI::VersionTag->autoCommitWorkingIfEnabled($self->session, { - allowComments => 1, - returnUrl => $self->getUrl, - }) eq 'redirect') { - return undef; - }; - return $self->session->asset($self->getContainer)->www_view; + my $result = WebGUI::VersionTag->autoCommitWorkingIfEnabled( + $session, { + allowComments => 1, + returnUrl => $self->getUrl, + } + ); + my $redirect = $result eq 'redirect'; + $session->asset($self->getContainer) unless $redirect; + return $redirect; +} + +#------------------------------------------------------------------- +sub _wwwCopyProgress { + my ($self, $childrenOnly) = @_; + my $session = $self->session; + my $i18n = WebGUI::International->new($session, 'Asset'); + + # This could potentially time out, so we'll render a progress bar. + my $pb = WebGUI::ProgressBar->new($session); + my @stack; + + return $pb->run( + title => $i18n->get('Copy Assets'), + icon => $session->url->extras('adminConsole/assets.gif'), + code => sub { + my $bar = shift; + my $newAsset = $self->duplicateBranch($childrenOnly); + $bar->update($i18n->get('cut')); + my $redirect = $self->_wwwCopyFinish($newAsset); + return $redirect ? $self->getUrl : $self->getContainer->getUrl; + }, + wrap => { + 'WebGUI::Asset::duplicateBranch' => sub { + my ($bar, $original, $asset, @args) = @_; + push(@stack, $asset->getTitle); + my $ret = $asset->$original(@args); + pop(@stack); + return $ret; + }, + 'WebGUI::Asset::duplicate' => sub { + my ($bar, $original, $asset, @args) = @_; + my $name = join '/', @stack, $asset->getTitle; + $bar->update($name); + return $asset->$original(@args); + }, + } + ); +} + +#------------------------------------------------------------------- +sub _wwwCopySingle { + my $self = shift; + my $newAsset = $self->duplicate({skipAutoCommitWorkflows => 1}); + my $redirect = $self->_wwwCopyFinish($newAsset); + return $redirect ? undef : $self->getContainer->www_view; } #------------------------------------------------------------------- diff --git a/lib/WebGUI/ProgressBar.pm b/lib/WebGUI/ProgressBar.pm index 5be25932a..d098d9deb 100644 --- a/lib/WebGUI/ProgressBar.pm +++ b/lib/WebGUI/ProgressBar.pm @@ -145,20 +145,27 @@ A message to be displayed in the status bar. =cut +{ + +# Keep the sprintf string short and don't recompute buffer breaker every time +# update is called +my $prefix = ' +'; + sub update { my $self = shift; my $message = shift; $message =~ s/'/\\'/g; ##Encode single quotes for JSON; $self->session->log->preventDebugOutput; - $self->{_counter} += 1; + my $counter = $self->{_counter} += 1; - my $modproxy_buffer_breaker = 'BUFFER BREAKER ' x 1000; - my $text = sprintf(<{_counter}, $message); - -EOJS + my $text = $prefix . sprintf($format, $counter, $message) . $suffix; + local $| = 1; # Tell modperl not to buffer the output $self->session->output->print($text, 1); #skipMacros if ($self->{_counter} > 600) { @@ -167,5 +174,92 @@ EOJS return ''; } -1; +} +#------------------------------------------------------------------- + +=head2 run ( options ) + +starts and finishes a progress bar, running some code in the middle. It +returns 'chunked' for convenience - if you don't use the return value, you +should return 'chunked' yourself. + +The following keyword arguments are accepted (either as a bare hash or a +hashref). + +=head3 code + +A coderef to run in between starting and stopping the progress bar. It is +passed the progress bar instance as its first and only argument. It should +return the url to redirect to with finish(), or a false value. + +=head3 arg + +An argument (just one) to be passed to code when it is called. + +=head3 title + +See start(). + +=head3 icon + +See start(). + +=head3 wrap + +A hashref of subroutine names to code references. While code is being called, +these subroutines will be wrapped with the provided code references, which +will be passed the progress bar instance, the original code reference, and any +arguments it would have received, similiar to a Moose 'around' method, e.g. + + wrap => { + 'WebGUI::Asset::update' => sub { + my $bar = shift; + my $original = shift; + $bar->update('some message'); + $original->(@_); + } + } + +=cut + +sub run { + my $self = shift; + my $args = $_[0]; + $args = { @_ } unless ref $args eq 'HASH'; + + my %original; + my $wrap = $args->{wrap}; + + $self->start($args->{title}, $args->{icon}); + + my $url = eval { + for my $name (keys %$wrap) { + my $original = $original{$name} = do { no strict 'refs'; \&$name }; + my $wrapper = $wrap->{$name}; + no strict 'refs'; + *$name = sub { + unshift(@_, $self, $original); + goto &$wrapper; + }; + } + + $args->{code}->($self, $args->{arg}); + }; + my $e = $@; + + # Always, always restore coderefs + for my $name (keys %original) { + my $c = $original{$name}; + if (ref $c eq 'CODE') { + no strict 'refs'; + *$name = $c; + } + } + + die $e if $e; + + return $self->finish($url || $self->session->url->page); +} + +1; diff --git a/lib/WebGUI/i18n/English/Asset.pm b/lib/WebGUI/i18n/English/Asset.pm index c159759b6..184bfaa04 100644 --- a/lib/WebGUI/i18n/English/Asset.pm +++ b/lib/WebGUI/i18n/English/Asset.pm @@ -320,6 +320,11 @@ our $I18N = { context => q|To remove an item from the clipboard, and put it on the current page.| }, + 'Copy Assets' => { + message => q|Copy Assets|, + lastUpdated => 1273518396, + }, + 'Paste Assets' => { message => q|Paste Assets|, lastUpdated => 1245342798, diff --git a/t/Asset/AssetClipboard.t b/t/Asset/AssetClipboard.t index 7b061377a..69c3752d5 100644 --- a/t/Asset/AssetClipboard.t +++ b/t/Asset/AssetClipboard.t @@ -22,7 +22,7 @@ use WebGUI::Asset; use WebGUI::VersionTag; use Test::More; # increment this value for each test you create -plan tests => 12; +plan tests => 27; my $session = WebGUI::Test->session; $session->user({userId => 3}); @@ -100,3 +100,59 @@ is($topFolder->cloneFromDb->get('state'), 'clipboard', '... state set to trash i is($folder1a->cloneFromDb->get('state'), 'clipboard-limbo', '... state set to clipboard-limbo on child #1'); is($folder1b->cloneFromDb->get('state'), 'clipboard-limbo', '... state set to clipboard-limbo on child #2'); is($folder1a2->cloneFromDb->get('state'), 'clipboard-limbo', '... state set to clipboard-limbo on grandchild #1-1'); + +sub is_tree_of_folders { + my ($asset, $depth, $pfx) = @_; + my $recursive; $recursive = sub { + my ($asset, $depth) = @_; + my $pfx = " $pfx $depth"; + return 0 unless isa_ok($asset, 'WebGUI::Asset::Wobject::Folder', + "$pfx: this object"); + + my $children = $asset->getLineage( + ['children'], { + statesToInclude => ['clipboard', 'clipboard-limbo' ], + returnObjects => 1, + } + ); + + return $depth < 2 + ? is(@$children, 0, "$pfx: leaf childless") + : is(@$children, 1, "$pfx: has child") + && $recursive->($children->[0], $depth - 1); + }; + + my $pass = $recursive->($asset, $depth); + undef $recursive; + my $message = "$pfx is tree of folders"; + return $pass ? pass $message : fail $message; +} + +# test www_copy +my $tag = WebGUI::VersionTag->create($session); +$tag->setWorking; +WebGUI::Test->tagsToRollback($tag); + +my $tempspace = WebGUI::Asset->getTempspace($session); +my $folder = {className => 'WebGUI::Asset::Wobject::Folder'}; +my $root = $tempspace->addChild($folder); +my $child = $root->addChild($folder); +my $grandchild = $child->addChild($folder); + +sub copied { + for my $a (@{$tempspace->getAssetsInClipboard}) { + if ($a->getParent->getId eq $tempspace->getId) { + return $a; + } + } + return undef; +} + +my @methods = qw(Single Children Descendants); +for my $i (0..2) { + my $meth = "_wwwCopy$methods[$i]"; + $root->$meth(); + my $clip = copied(); + is_tree_of_folders($clip, $i+1, $meth); + $clip->purge; +} diff --git a/t/ProgressBar.t b/t/ProgressBar.t new file mode 100644 index 000000000..f4e582b79 --- /dev/null +++ b/t/ProgressBar.t @@ -0,0 +1,145 @@ +#------------------------------------------------------------------- +# 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 +#------------------------------------------------------------------ + +{ + package WebGUI::Test::ProgressBar; + use warnings; + use strict; + + sub new { bless {}, shift } + + sub foo { $_[0]->{foo} = $_[1] } + + sub bar { $_[0]->{bar} = $_[1] } +} + +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin/lib"; + +use Test::More; +use Test::MockObject::Extends; +use WebGUI::Test; +use WebGUI::Session; + +my $session = WebGUI::Test->session; + +# Test the run method of ProgessBar -- it does some symbol table +# manipulation... + +my $TestTitle = 'test title'; +my $TestIcon = '/test/icon'; +my $TestUrl = 'http://test.com/url'; + +my ($started, $finished); +my @updates = qw(one two not used); + +sub mockbar { + Test::MockObject::Extends->new(WebGUI::ProgressBar->new($session)); +} + +my $pb = mockbar + ->mock(start => sub { + my ($self, $title, $icon) = @_; + is $title, $TestTitle, 'title'; + is $icon, $TestIcon, 'icon'; + ok !$started, q"hadn't started yet"; + $started = 1; + }) + ->mock(update => sub { + my ($self, $message) = @_; + my $expected = shift(@updates); + is $message, $expected, 'message'; + }) + ->mock(finish => sub { + my ($self, $url) = @_; + is $url, $TestUrl, 'url'; + ok !$finished, q"hadn't finished yet"; + $finished = 1; + return 'chunked'; + }); + +my $object = WebGUI::Test::ProgressBar->new; +ok !$object->{foo}, 'no foo'; +ok !$object->{bar}, 'no bar'; + +sub wrapper { + my ($bar, $original, $obj, $val) = @_; + $bar->update($val); + $obj->$original($val); +} + +is $pb->run( + arg => 'argument', + title => $TestTitle, + icon => $TestIcon, + code => sub { + my ($bar, $arg) = @_; + isa_ok $bar, 'WebGUI::ProgressBar', 'code invocant'; + is $arg, 'argument', 'code argument'; + ok $started, 'started'; + ok !$finished, 'not finished yet'; + is $object->foo('one'), 'one', 'wrapped return'; + is $object->bar('two'), 'two', 'wrapped return (again)'; + return $TestUrl; + }, + wrap => { + 'WebGUI::Test::ProgressBar::foo' => \&wrapper, + 'WebGUI::Test::ProgressBar::bar' => \&wrapper, + } +), 'chunked', 'run return value'; + +ok $finished, 'finished now'; +is $object->{foo}, 'one', 'foo original called'; +is $object->{bar}, 'two', 'bar original called'; +$object->foo('foo'); +is $object->{foo}, 'foo', 'foo still works'; +$object->bar('bar'); +is $object->{bar}, 'bar', 'bar still works'; +is @updates, 2, 'no shifting from updates after run'; + +delete @{$object}{qw(foo bar)}; + +my $updated; +# make sure that the symbol table machinations work even when something dies +$pb = mockbar->mock(start => sub {}) + ->mock(finish => sub {}) + ->mock(update => sub { $updated = 1 }); + +eval { + $pb->run( + code => sub { + $object->foo('foo'); + $object->bar('bar'); + }, + wrap => { + 'WebGUI::Test::ProgressBar::foo' => \&wrapper, + 'WebGUI::Test::ProgressBar::bar' => sub { die "blar!\n" } + } + ); +}; +my $e = $@; + +is $e, "blar!\n", 'exception propogated'; +is $object->{foo}, 'foo', 'foo after die'; +ok !$object->{bar}, 'bar did not get set'; +$object->bar('bar'); +is $object->{bar}, 'bar', 'but it works now'; + +ok $updated, 'update called for foo'; +$updated = 0; +$object->foo('ignored'); +ok !$updated, 'update not called for foo'; + +done_testing; + +#vim:ft=perl