diff --git a/docs/changelog/7.x.x.txt b/docs/changelog/7.x.x.txt index 30a36ce60..889226c90 100644 --- a/docs/changelog/7.x.x.txt +++ b/docs/changelog/7.x.x.txt @@ -1,6 +1,9 @@ 7.10.3 7.10.2 + - Added WebGUI::Fork api + - Moved html export to Fork + - Moved clipboard functions to Fork - fixed #11884: Editing Templates impossible / Code editor not loaded - recommitted ukplayer. Removal broke Matrix. Licencing information was available but overlooked. - fixed #11883: Wiki "Add page" link does not encode special chars diff --git a/docs/gotcha.txt b/docs/gotcha.txt index 25f6e89cd..e79db5162 100644 --- a/docs/gotcha.txt +++ b/docs/gotcha.txt @@ -19,6 +19,8 @@ save you many hours of grief. is in WebGUI again. Licencing information was overlooked. An upgrade to 7.10.1 will break the Matrix. This is fixed now. + * WebGUI now depends on Monkey::Patch for sanely scoped monkeypatching. + 7.10.1 -------------------------------------------------------------------- * WebGUI now depends on PerlIO::eol, for doing line ending translation. diff --git a/docs/upgrades/upgrade_7.10.1-7.10.2.pl b/docs/upgrades/upgrade_7.10.1-7.10.2.pl index e7044997d..410288491 100644 --- a/docs/upgrades/upgrade_7.10.1-7.10.2.pl +++ b/docs/upgrades/upgrade_7.10.1-7.10.2.pl @@ -47,6 +47,7 @@ sub addForkTable { my $sql = q{ CREATE TABLE Fork ( id CHAR(22), + userId CHAR(22), groupId CHAR(22), status LONGTEXT, error TEXT, diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 34194743b..4c86c7353 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -37,6 +37,9 @@ use WebGUI::HTML; use WebGUI::HTMLForm; use WebGUI::Keyword; use WebGUI::ProgressBar; +use WebGUI::ProgressTree; +use Monkey::Patch; +use WebGUI::Fork; use WebGUI::Search::Index; use WebGUI::TabForm; use WebGUI::Utility; @@ -2555,6 +2558,34 @@ sub setSize { $self->{_properties}{assetSize} = $size; } +#------------------------------------------------------------------- + +=head2 setState ( $state ) + +Updates the asset table with the new state of the asset. + +=cut + +sub setState { + my ($self, $state) = @_; + my $sql = q{ + UPDATE asset + SET state = ?, + stateChangedBy = ?, + stateChanged = ? + WHERE assetId = ? + }; + $self->session->db->write( + $sql, [ + $state, + $self->session->user->userId, + time, + $self->getId, + ] + ); + $self->{_properties}->{state} = $state; + $self->purgeCache; +} #------------------------------------------------------------------- diff --git a/lib/WebGUI/AssetBranch.pm b/lib/WebGUI/AssetBranch.pm index f13a13daf..3de109fc5 100644 --- a/lib/WebGUI/AssetBranch.pm +++ b/lib/WebGUI/AssetBranch.pm @@ -46,13 +46,26 @@ Duplicates this asset and the entire subtree below it. Returns the root of the If true, then only children, and not descendants, will be duplicated. +=head3 $state + +Set this to "clipboard" if you want the resulting asset to be on the clipboard +(rather than published) when we're done. + =cut sub duplicateBranch { - my $self = shift; - my $childrenOnly = shift; + my ($self, $childrenOnly, $state) = @_; + my $session = $self->session; + my $log = $session->log; + my $clipboard = $state && $state =~ /^clipboard/; + + my $newAsset = $self->duplicate( + { skipAutoCommitWorkflows => 1, + skipNotification => 1, + state => $state, + } + ); - my $newAsset = $self->duplicate({skipAutoCommitWorkflows=>1,skipNotification=>1}); # Correctly handle positions for Layout assets my $contentPositions = $self->get("contentPositions"); my $assetsToHide = $self->get("assetsToHide"); @@ -66,7 +79,21 @@ sub duplicateBranch { next; } last unless $child; - my $newChild = $childrenOnly ? $child->duplicate({skipAutoCommitWorkflows=>1, skipNotification=>1}) : $child->duplicateBranch; + my $newChild; + if ($childrenOnly) { + $newChild = $child->duplicate( + { skipAutoCommitWorkflows => 1, + skipNotification => 1, + state => $clipboard && 'clipboard-limbo', + } + ); + } + elsif($clipboard) { + $newChild = $child->duplicateBranch(0, 'clipboard-limbo'); + } + else { + $newChild = $child->duplicateBranch; + } $newChild->setParent($newAsset); my ($oldChildId, $newChildId) = ($child->getId, $newChild->getId); $contentPositions =~ s/\Q${oldChildId}\E/${newChildId}/g if ($contentPositions); diff --git a/lib/WebGUI/AssetClipboard.pm b/lib/WebGUI/AssetClipboard.pm index dc1ddf8d9..2bb5c7609 100644 --- a/lib/WebGUI/AssetClipboard.pm +++ b/lib/WebGUI/AssetClipboard.pm @@ -49,6 +49,55 @@ sub canPaste { return $self->validParent($self->session); ##Lazy call to a class method } +#------------------------------------------------------------------- + +=head2 copyInBackground ( $process, $args ) + +WebGUI::Fork method called by www_copy + +=cut + +sub copyInBackground { + my ($process, $args) = @_; + my $session = $process->session; + my $asset = WebGUI::Asset->new($session, $args->{assetId}); + my @pedigree = ('self'); + my $childrenOnly = 0; + if ($args->{childrenOnly}) { + $childrenOnly = 1; + push @pedigree, 'children'; + } + else { + push @pedigree, 'descendants'; + } + my $ids = $asset->getLineage(\@pedigree); + my $tree = WebGUI::ProgressTree->new($session, $ids); + my $patch = Monkey::Patch::patch_class 'WebGUI::Asset', 'duplicate', sub { + my $duplicate = shift; + my $self = shift; + my $id = $self->getId; + my $asset = eval { $self->$duplicate(@_) }; + my $e = $@; + if ($e) { + $tree->note($id, $e); + $tree->failure($id, 'Died'); + } + else { + $tree->success($id); + } + $process->update(sub { $tree->json }); + die $e if $e; + return $asset; + }; + my $newAsset = $asset->duplicateBranch($childrenOnly, 'clipboard'); + $newAsset->update({ title => $newAsset->getTitle . ' (copy)'}); + if ($args->{commit}) { + my $tag = WebGUI::VersionTag->getWorking($session); + $tag->requestCommit(); + } +} + + #------------------------------------------------------------------- =head2 cut ( ) @@ -97,6 +146,10 @@ A hash reference of options that can modify how this method works. Assets that normally autocommit their workflows (like CS Posts, and Wiki Pages) won't if this is true. +=head4 state + +A state for the duplicated asset (defaults to 'published') + =cut sub duplicate { @@ -132,6 +185,10 @@ sub duplicate { keywords => $keywords, } ); + if (my $state = $options->{state}) { + $newAsset->setState($state); + } + return $newAsset; } @@ -218,11 +275,12 @@ sub paste { my $i18n=WebGUI::International->new($session, 'Asset'); $outputSub->(sprintf $i18n->get('pasting %s'), $pastedAsset->getTitle) if defined $outputSub; if ($self->getId eq $pastedAsset->get("parentId") || $pastedAsset->setParent($self)) { - $pastedAsset->publish(['clipboard','clipboard-limbo']); # Paste only clipboard items - $pastedAsset->updateHistory("pasted to parent ".$self->getId); - # Update lineage in search index. - my $assetIter = $pastedAsset->getLineageIterator(['self', 'descendants']); + my $assetIter = $pastedAsset->getLineageIterator( + ['self', 'descendants'], { + statesToInclude => ['clipboard','clipboard-limbo'] + } + ); while ( 1 ) { my $asset; eval { $asset = $assetIter->() }; @@ -233,15 +291,67 @@ sub paste { last unless $asset; $outputSub->(sprintf $i18n->get('indexing %s'), $pastedAsset->getTitle) if defined $outputSub; + $asset->setState('published'); $asset->indexContent(); } - + $pastedAsset->updateHistory("pasted to parent ".$self->getId); return 1; } return 0; } +#------------------------------------------------------------------- + +=head2 pasteInBackground ( ) + +WebGUI::Fork method called by www_pasteList + +=cut + +sub pasteInBackground { + my ($process, $args) = @_; + my $session = $process->session; + my $self = WebGUI::Asset->new($session, $args->{assetId}); + my @roots = grep { $_ && $_->canEdit } + map { WebGUI::Asset->newPending($session, $_) } + @{ $args->{list} }; + + my @ids; + for my $r (@roots) { + my $these = $r->getLineage( + ['self', 'descendants'], { + statesToInclude => ['clipboard', 'clipboard-limbo'] + } + ); + push(@ids, @$these); + } + + my $tree = WebGUI::ProgressTree->new($session, \@ids); + my $patch = Monkey::Patch::patch_class( + 'WebGUI::Asset', 'indexContent', sub { + my $indexContent = shift; + my $self = shift; + my $id = $self->getId; + $tree->focus($id); + my $ret = eval { $self->$indexContent(@_) }; + my $e = $@; + if ($e) { + $tree->note($id, $e); + $tree->failure($id, 'Died'); + } + else { + $tree->success($id); + } + $process->update(sub { $tree->json }); + die $e if $e; + return $ret; + } + ); + $self->paste($_->getId) for @roots; +} + + #------------------------------------------------------------------- =head2 www_copy ( ) @@ -255,89 +365,54 @@ If with children/descendants is selected, a progress bar will be rendered. sub www_copy { my $self = shift; my $session = $self->session; + my $http = $session->http; + my $redir = $self->getParent->getUrl; return $session->privilege->insufficient unless $self->canEdit; my $with = $session->form->get('with'); + my %args; if ($with eq 'children') { - $self->_wwwCopyChildren; + $args{childrenOnly} = 1; } - elsif ($with eq 'descendants') { - $self->_wwwCopyDescendants; + elsif ($with ne 'descendants') { + my $newAsset = $self->duplicate({ + skipAutoCommitWorkflows => 1, + state => 'clipboard' + } + ); + $newAsset->update({ title => $newAsset->getTitle . ' (copy)'}); + my $result = WebGUI::VersionTag->autoCommitWorkingIfEnabled( + $session, { + allowComments => 1, + returnUrl => $redir, + } + ); + $http->setRedirect($redir) unless $result eq 'redirect'; + return 'redirect'; } - else { - $self->_wwwCopySingle; + + my $tag = WebGUI::VersionTag->getWorking($session); + if ($tag->canAutoCommit) { + $args{commit} = 1; + unless ($session->setting->get('skipCommitComments')) { + $redir = $tag->autoCommitUrl($redir); + } } -} -#------------------------------------------------------------------- -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; - my $result = WebGUI::VersionTag->autoCommitWorkingIfEnabled( - $session, { - allowComments => 1, - returnUrl => $self->getUrl, + $args{assetId} = $self->getId; + my $process = WebGUI::Fork->start( + $session, 'WebGUI::Asset', 'copyInBackground', \%args + ); + my $i18n = WebGUI::International->new($session, 'Asset'); + my $pairs = $process->contentPairs( + 'ProgressTree', { + title => $i18n->get('Copy Assets'), + icon => 'assets', + proceed => $redir } ); - 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; + $http->setRedirect($self->getUrl($pairs)); + return 'redirect'; } #------------------------------------------------------------------- @@ -363,9 +438,8 @@ sub www_copyList { foreach my $assetId ($session->form->param("assetId")) { my $asset = WebGUI::Asset->newByDynamicClass($session,$assetId); if ($asset->canEdit) { - my $newAsset = $asset->duplicate({skipAutoCommitWorkflows => 1}); + my $newAsset = $asset->duplicate({skipAutoCommitWorkflows => 1, state => 'clipboard'}); $newAsset->update({ title=>$newAsset->getTitle.' (copy)'}); - $newAsset->cut; } } if ($self->session->form->process("proceed") ne "") { @@ -503,7 +577,7 @@ sub www_duplicateList { foreach my $assetId ($session->form->param("assetId")) { my $asset = WebGUI::Asset->newByDynamicClass($session,$assetId); if ($asset->canEdit) { - my $newAsset = $asset->duplicate({skipAutoCommitWorkflows => 1, }); + my $newAsset = $asset->duplicate({skipAutoCommitWorkflows => 1}); $newAsset->update({ title=>$newAsset->getTitle.' (copy)'}); } } @@ -657,25 +731,29 @@ sub www_pasteList { my $self = shift; my $session = $self->session; return $session->privilege->insufficient() unless $self->canEdit && $session->form->validToken; - my $form = $session->form; - my $pb = WebGUI::ProgressBar->new($session); - ##Need to store the list of assetIds for the status subroutine - my @assetIds = $form->param('assetId'); - ##Need to set the URL that should be displayed when it is done - my $i18n = WebGUI::International->new($session, 'Asset'); - $pb->start($i18n->get('Paste Assets'), $session->url->extras('adminConsole/assets.gif')); - ASSET: foreach my $clipId (@assetIds) { - next ASSET unless $clipId; - my $pasteAsset = WebGUI::Asset->newPending($session, $clipId); - if (! $pasteAsset && $pasteAsset->canEdit) { - $pb->update(sprintf $i18n->get('skipping %s'), $pasteAsset->getTitle); - next ASSET; - } - $self->paste($clipId, sub {$pb->update(@_);}); - } - return $pb->finish( ($form->param('proceed') eq 'manageAssets') ? $self->getUrl('op=assetManager') : $self->getUrl ); -} + my $form = $session->form; + my $process = WebGUI::Fork->start( + $session, 'WebGUI::Asset', 'pasteInBackground', { + assetId => $self->getId, + list => [ $form->get('assetId') ], + } + ); + + my $redir = $self->getUrl( + ($form->get('proceed') eq 'manageAssets') ? 'op=assetManager' : () + ); + my $i18n = WebGUI::International->new($session, 'Asset'); + my $pairs = $process->contentPairs( + 'ProgressTree', { + title => $i18n->get('Paste Assets'), + icon => 'assets', + proceed => $redir, + } + ); + $session->http->setRedirect($self->getUrl($pairs)); + return 'redirect'; +} 1; diff --git a/lib/WebGUI/AssetExportHtml.pm b/lib/WebGUI/AssetExportHtml.pm index 3f1d951f7..9bccdd535 100644 --- a/lib/WebGUI/AssetExportHtml.pm +++ b/lib/WebGUI/AssetExportHtml.pm @@ -24,6 +24,7 @@ use WebGUI::Utility (); use WebGUI::Session; use URI::URL; use Scope::Guard qw(guard); +use WebGUI::ProgressTree; =head1 NAME @@ -400,7 +401,7 @@ sub exportBranch { close $handle; $cs->var->end; $cs->close(); - $asset->$report('collateral notes', $output); + $asset->$report('collateral notes', $output) if $output; }; my $path = $asset->exportGetUrlAsPath; eval { $asset->exportAssetCollateral($path, $options, $cs) }; @@ -666,48 +667,33 @@ specified asset and keeps a json structure as the status. =cut sub exportInFork { - my ($process, $args) = @_; - my $self = WebGUI::Asset->new($process->session, delete $args->{assetId}); + my ( $process, $args ) = @_; + my $session = $process->session; + my $self = WebGUI::Asset->new( $session, delete $args->{assetId} ); $args->{indexFileName} = delete $args->{index}; - my %flat; - - my $hashify; $hashify = sub { - my ($asset, $depth) = @_; - return if $depth < 1; - my $hash = { url => $asset->getUrl }; - my $children = $asset->getLineage(['children'], { returnObjects => 1 }); - $hash->{children} = [ map { $hashify->($_, $depth - 1) } @$children ]; - $flat{$asset->getId} = $hash; - return $hash; - }; - my $tree = $hashify->($self, $args->{depth}); - my $last = $tree; + my $assetIds = $self->exportGetDescendants( undef, $args->{depth} ); + my $tree = WebGUI::ProgressTree->new( $session, $assetIds ); my %reports = ( - 'bad user privileges' => sub { shift->{badUserPrivileges} = 1 }, - 'not exportable' => sub { shift->{notExportable} = 1 }, - 'done' => sub { shift->{done} = 1 }, - 'exporting page' => sub { - my $hash = shift; - $hash->{current} = 1; - delete $last->{current}; - $last = $hash; + 'done' => sub { $tree->success(shift) }, + 'exporting page' => sub { $tree->focus(shift) }, + 'collateral notes' => sub { $tree->note(@_) }, + 'bad user privileges' => sub { + $tree->failure( shift, 'Bad User Privileges' ); }, - 'collateral notes' => sub { - my ($hash, $text) = @_; - $hash->{collateralNotes} = $text if $text; + 'not exportable' => sub { + $tree->failure( shift, 'Not Exportable' ); }, ); $args->{report} = sub { - my ($asset, $key, @args) = @_; + my ( $asset, $key, @args ) = @_; my $code = $reports{$key}; - my $hash = $flat{$asset->getId}; - $code->($hash, @args); - $process->update(sub { JSON::encode_json($tree) }); + $code->( $asset->getId, @args ); + $process->update( sub { $tree->json } ); }; $self->exportAsHtml($args); - delete $last->{current}; - $process->update(JSON::encode_json($tree)); -} + $tree->focus(undef); + $process->update( $tree->json ); +} ## end sub exportInFork #------------------------------------------------------------------- @@ -1036,7 +1022,12 @@ sub www_exportStatus { } ); $process->setGroup(13); - my $pairs = $process->contentPairs('AssetExport'); + my $i18n = WebGUI::International->new( $session, 'Asset' ); + my $pairs = $process->contentPairs('ProgressTree', { + icon => 'assets', + title => $i18n->get('Page Export Status'), + } + ); $session->http->setRedirect($self->getUrl($pairs)); return 'redirect'; } diff --git a/lib/WebGUI/Fork.pm b/lib/WebGUI/Fork.pm index 09b26473c..954bdc2d7 100644 --- a/lib/WebGUI/Fork.pm +++ b/lib/WebGUI/Fork.pm @@ -88,41 +88,59 @@ sub canView { my $user = shift || $session->user; $user = WebGUI::User->new( $session, $user ) unless eval { $user->isa('WebGUI::User') }; - return 1 if $user->isAdmin; - return $user->isInGroup( $self->getGroupId ); + return + $user->isAdmin + || $user->userId eq $self->getUserId + || $user->isInGroup( $self->getGroupId ); } #------------------------------------------------------------------- -=head2 contentPairs ($module, $pid) +=head2 contentPairs ($module, $pid, $extra) Returns a bit of query string useful for redirecting to a WebGUI::Operation::Fork plugin. $module should be the bit that comes after WebGUI::Operation::Fork, e.g. $process->contentPairs('Foo') should return something like "op=fork;module=Foo;pid=adlfjafo87ad9f78a7", which will -get dispatched to WebGUI::Operation::Fork::Foo::handler($process) +get dispatched to WebGUI::Operation::Fork::Foo::handler($process). + +$extra is an optional hashref that will add further parameters onto the list +of pairs, e.g. { foo => 'bar' } becomes ';foo=bar' =cut sub contentPairs { - my ( $self, $module ) = @_; - my $pid = $self->getId; - return "op=fork;module=$module;pid=$pid"; -} + my ( $self, $module, $extra ) = @_; + my $url = $self->session->url; + my $pid = $self->getId; + my %params = ( + op => 'fork', + module => $module, + pid => $self->getId, + $extra ? %$extra : () + ); + return join( + ';', + map { + my $k = $_; + join( '=', map { $url->escape($_) } ( $k, $params{$k} ) ); + } keys %params + ); +} ## end sub contentPairs #----------------------------------------------------------------- =head2 create ( ) -Internal class method. Creates a new Fork object and inserts a -blank row of data into the db. +Internal class method. Creates a new Fork object inserts it into the db. =cut sub create { my ( $class, $session ) = @_; my $id = $session->id->generate; - $session->db->setRow( $class->tableName, 'id', {}, $id ); + my %data = ( userId => $session->user->userId ); + $session->db->setRow( $class->tableName, 'id', \%data, $id ); bless { session => $session, id => $id }, $class; } @@ -275,9 +293,9 @@ sub forkAndExec { Get data from the database record for this process (returned as a simple list, not an arrayref). Valid keys are: id, status, error, startTime, endTime, -finished, groupId. They all have more specific accessors, but you can use -this to get several at once if you're very careful. You should probably use -the accessors, though, since some of them have extra logic. +finished, groupId, userId. They all have more specific accessors, but you can +use this to get several at once if you're very careful. You should probably +use the accessors, though, since some of them have extra logic. =cut @@ -356,6 +374,16 @@ sub getStatus { #----------------------------------------------------------------- +=head2 getUserId + +Returns the userId of the user who initiated this Fork. + +=cut + +sub getUserId { $_[0]->get('userId') } + +#----------------------------------------------------------------- + =head2 init ( ) Spawn a master process from which Forks will fork(). The intent diff --git a/lib/WebGUI/Fork/AssetExport.pm b/lib/WebGUI/Fork/ProgressTree.pm similarity index 50% rename from lib/WebGUI/Fork/AssetExport.pm rename to lib/WebGUI/Fork/ProgressTree.pm index e7440d888..7a51e0e9c 100644 --- a/lib/WebGUI/Fork/AssetExport.pm +++ b/lib/WebGUI/Fork/ProgressTree.pm @@ -1,4 +1,4 @@ -package WebGUI::Fork::AssetExport; +package WebGUI::Fork::ProgressTree; =head1 LEGAL @@ -19,12 +19,12 @@ use warnings; =head1 NAME -WebGUI::Fork::AssetExport +WebGUI::Fork::ProgressTree =head1 DESCRIPTION Renders an admin console page that polls ::Status to draw a friendly graphical -representation of how an export is coming along. +representation of how progress on a tree of assets is coming along. =head1 SUBROUTINES @@ -33,77 +33,99 @@ These subroutines are available from this package: =cut use Template; +use HTML::Entities; +use JSON; my $template = <<'TEMPLATE';

-Currently exporting +

+
+
+
+
+Current asset: (/).
seconds elapsed. -

-[% MACRO yui(file) BLOCK %] - -[% END %] +[% MACRO inc(file) BLOCK %][% END %] +[% MACRO yui(file) BLOCK %][% inc("yui/build/$file") %][% END %] [% yui("yahoo/yahoo-min.js") %] [% yui("json/json-min.js") %] [% yui("event/event-min.js") %] [% yui("connection/connection_core-min.js") %] +[% inc("underscore/underscore-min.js") %] TEMPLATE my $stylesheet = <<'STYLESHEET'; STYLESHEET @@ -157,17 +185,21 @@ sub handler { my $process = shift; my $session = $process->session; my $url = $session->url; + my $form = $session->form; my $tt = Template->new( { INTERPOLATE => 1 } ); my %vars = ( - statusUrl => $url->page( $process->contentPairs('Status') ), - extras => $session->url->extras, + params => JSON::encode_json( { + statusUrl => $url->page( $process->contentPairs('Status') ), + redirect => scalar $form->get('proceed'), + } + ), + extras => $url->extras, ); $tt->process( \$template, \%vars, \my $content ) or die $tt->error; - my $console = WebGUI::AdminConsole->new( $process->session, 'assets' ); + my $console = WebGUI::AdminConsole->new( $session, $form->get('icon') ); $session->style->setRawHeadTags($stylesheet); - my $i18n = WebGUI::International->new( $session, 'Asset' ); - return $console->render( $content, $i18n->get('Page Export Status') ); + return $console->render( $content, encode_entities( $form->get('title') ) ); } ## end sub handler 1; diff --git a/lib/WebGUI/ProgressTree.pm b/lib/WebGUI/ProgressTree.pm new file mode 100644 index 000000000..079907ba5 --- /dev/null +++ b/lib/WebGUI/ProgressTree.pm @@ -0,0 +1,172 @@ +package WebGUI::ProgressTree; + +use warnings; +use strict; + +=head1 NAME + +WebGUI::ProgressTree + +=head1 DESCRIPTION + +Helper functions for maintaining a JSON represtentation of the progress of an +operation that modifies a tree of assets. See WebGUI::Fork::ProgressTree for a +status page that renders this. + +=head1 SYNOPSIS + + my $tree = WebGUI::ProgressTree->new($session, \@assetIds); + $tree->success($assetId); + $tree->failure($assetId, $reason); + $tree->note($assetId, 'something about this one...'); + +=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 + ------------------------------------------------------------------- + +=head1 METHODS + +=cut + +#------------------------------------------------------------------- + +=head2 new ($session, $assetIds) + +Constructs new tree object for tracking the progress of $assetIds. + +=cut + +sub new { + my ( $class, $session, $assetIds ) = @_; + my $db = $session->db; + my $dbh = $db->dbh; + my $set = join( ',', map { $dbh->quote($_) } @$assetIds ); + my $sql = qq{ + SELECT a.assetId, a.parentId, d.url + FROM asset a INNER JOIN assetData d ON a.assetId = d.assetId + WHERE a.assetId IN ($set) + ORDER BY a.lineage ASC, d.revisionDate DESC + }; + my $sth = $db->read($sql); + my ( %flat, @roots ); + + while ( my $asset = $sth->hashRef ) { + my ( $id, $parentId ) = delete @{$asset}{ 'assetId', 'parentId' }; + + # We'll get back multiple rows for each asset, but the first one is + # the latest. Skip the others. + next if $flat{$id}; + $flat{$id} = $asset; + if ( my $parent = $flat{$parentId} ) { + push( @{ $parent->{children} }, $asset ); + } + else { + push( @roots, $asset ); + } + } + my $self = { + session => $session, + tree => \@roots, + flat => \%flat, + }; + bless $self, $class; +} ## end sub new + +#------------------------------------------------------------------- + +=head2 success ($assetId) + +Whatever we were doing to $assetId succeeded. Woohoo! + +=cut + +sub success { + my ( $self, $assetId ) = @_; + $self->{flat}->{$assetId}->{success} = 1; +} + +#------------------------------------------------------------------- + +=head2 failure ($assetId, $reason) + +Whatever we were doing to $assetId didn't work for $reason. Aww. + +=cut + +sub failure { + my ( $self, $assetId, $reason ) = @_; + $self->{flat}->{$assetId}->{failure} = $reason; +} + +#------------------------------------------------------------------- + +=head2 note ($assetId, $note) + +Add some extra text. WebGUI::Fork::ProgressTree displays these as paragraphs +under the node for this asset. + +=cut + +sub note { + my ( $self, $assetId, $note ) = @_; + push( @{ $self->{flat}->{$assetId}->{notes} }, $note ); +} + +#------------------------------------------------------------------- + +=head2 focus ($assetId) + +Make a note that this is the asset that we are currently doing something with. + +=cut + +sub focus { + my ( $self, $assetId ) = @_; + if ( my $last = delete $self->{last} ) { + delete $last->{focus}; + } + if ($assetId) { + my $focus = $self->{last} = $self->{flat}->{$assetId}; + $focus->{focus} = 1; + } +} + +#------------------------------------------------------------------- + +=head2 tree + +A hashy representation of the status of this tree of assets. + +=cut + +sub tree { $_[0]->{tree} } + +#------------------------------------------------------------------- + +=head2 json + +$self->tree encoded as json. + +=cut + +sub json { JSON::encode_json( $_[0]->tree ) } + +#------------------------------------------------------------------- + +=head2 session + +The WebGUI::Session this progress tree is associated with. + +=cut + +sub session { $_[0]->{session} } + +1; diff --git a/lib/WebGUI/VersionTag.pm b/lib/WebGUI/VersionTag.pm index cc5b8afb5..eba44462a 100644 --- a/lib/WebGUI/VersionTag.pm +++ b/lib/WebGUI/VersionTag.pm @@ -37,6 +37,23 @@ These methods are available from this class: =cut +#------------------------------------------------------------------- + +=head2 autoCommitUrl ( $base ) + +Returns the url autoCommitWorkingIfEnabled would redirect to if it were going +to. + +=cut + +sub autoCommitUrl { + my $self = shift; + my $session = $self->session; + my $url = $session->url; + my $base = shift || $url->page; + my $id = $self->getId; + return $url->append($base, "op=commitVersionTag;tagId=$id"); +} #------------------------------------------------------------------- @@ -75,25 +92,13 @@ sub autoCommitWorkingIfEnabled { return undef unless $versionTag; - #Auto commit is no longer determined from autoRequestCommit - - # auto commit assets - # save and commit button and site wide auto commit work the same - # Do not auto commit if tag is system wide tag or tag belongs to someone else - if ( - $options->{override} - || ( $class->getVersionTagMode($session) eq q{autoCommit} - && ! $versionTag->get(q{isSiteWide}) - && $versionTag->get(q{createdBy}) eq $session->user()->userId() - ) - ) { + if ($options->{override} || $versionTag->canAutoCommit) { if ($session->setting->get("skipCommitComments") || !$options->{allowComments}) { $versionTag->requestCommit; return 'commit'; } else { - my $url = $options->{returnUrl} || $session->url->page; - $url = $session->url->append($url, "op=commitVersionTag;tagId=" . $versionTag->getId); + my $url = $versionTag->autoCommitUrl($options->{returnUrl}); $session->http->setRedirect($url); return 'redirect'; } @@ -103,6 +108,24 @@ sub autoCommitWorkingIfEnabled { #------------------------------------------------------------------- +=head2 canAutoCommit + +Returns true if we would autocommit this tag without an override. + +=cut + +sub canAutoCommit { + my $self = shift; + my $session = $self->session; + my $class = ref $self; + my $mode = $class->getVersionTagMode($session); + return $mode eq 'autoCommit' + && !$self->get('isSiteWide') + && $self->get('createdBy') eq $session->user->userId; +} + +#------------------------------------------------------------------- + =head2 clearWorking ( ) Makes it so this tag is no longer the working tag for any user. diff --git a/sbin/testEnvironment.pl b/sbin/testEnvironment.pl index 3572dafc9..f550d4da8 100755 --- a/sbin/testEnvironment.pl +++ b/sbin/testEnvironment.pl @@ -145,6 +145,7 @@ checkModule("CHI", "0.34" ); checkModule('IO::Socket::SSL', ); checkModule('Net::Twitter', "3.13006" ); checkModule('PerlIO::eol', "0.14" ); +checkModule('Monkey::Patch', '0.3' ); failAndExit("Required modules are missing, running no more checks.") if $missingModule;