ProgressBar::run and now Asset->www_copy has a bar
This commit is contained in:
Paul Driver
parent
67a66647ec
commit
503a378756
6 changed files with 394 additions and 31 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -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 = '<script type="text/javascript">
|
||||
/* ' . 'BUFFER BREAKER ' x 1000 . ' */
|
||||
updateWgProgressBar(';
|
||||
my $format = q"'%dpx', '%s'";
|
||||
my $suffix = ');
|
||||
</script>
|
||||
';
|
||||
|
||||
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(<<EOJS, $self->{_counter}, $message);
|
||||
<script type="text/javascript">
|
||||
/* $modproxy_buffer_breaker */
|
||||
updateWgProgressBar('%dpx', '%s');
|
||||
</script>
|
||||
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;
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
|
|
|||
145
t/ProgressBar.t
Normal file
145
t/ProgressBar.t
Normal file
|
|
@ -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
|
||||
Loading…
Add table
Add a link
Reference in a new issue