diff --git a/docs/changelog/7.x.x.txt b/docs/changelog/7.x.x.txt index d1aafedfe..64b973176 100644 --- a/docs/changelog/7.x.x.txt +++ b/docs/changelog/7.x.x.txt @@ -1,4 +1,9 @@ 7.10.4 + - Added WebGUI::Fork api + - Moved html export to Fork + - Moved clipboard functions to Fork + - Moved trash functions to Fork + - Moved version tag rollback to Fork - fixed #11929: In/Out board breaks in Chrome sometimes - fixed #11928: Story Archive breaks if url has extension - fixed #11920: Defaul DataForm emails missing entries. diff --git a/docs/upgrades/upgrade_7.10.3-7.10.4.pl b/docs/upgrades/upgrade_7.10.3-7.10.4.pl index 247265ce7..43177f312 100644 --- a/docs/upgrades/upgrade_7.10.3-7.10.4.pl +++ b/docs/upgrades/upgrade_7.10.3-7.10.4.pl @@ -22,7 +22,7 @@ use Getopt::Long; use WebGUI::Session; use WebGUI::Storage; use WebGUI::Asset; - +use List::Util qw(first); my $toVersion = '7.10.4'; my $quiet; # this line required @@ -32,6 +32,8 @@ my $session = start(); # this line required # upgrade functions go here changeTemplateHelpUrl($session); +addForkTable($session); +installForkCleanup($session); finish($session); # this line required @@ -66,6 +68,49 @@ sub changeTemplateHelpUrl { print "DONE!\n" unless $quiet; } +#---------------------------------------------------------------------------- +# Creates a new table for tracking background processes +sub addForkTable { + my $session = shift; + my $db = $session->db; + my $sth = $db->dbh->table_info('', '', 'Fork', 'TABLE'); + return if ($sth->fetch); + print "\tAdding Fork table..." unless $quiet; + my $sql = q{ + CREATE TABLE Fork ( + id CHAR(22), + userId CHAR(22), + groupId CHAR(22), + status LONGTEXT, + error TEXT, + startTime BIGINT(20), + endTime BIGINT(20), + finished BOOLEAN DEFAULT FALSE, + latch BOOLEAN DEFAULT FALSE, + + PRIMARY KEY(id) + ); + }; + $db->write($sql); + print "DONE!\n" unless $quiet; +} + +#---------------------------------------------------------------------------- +# install a workflow to clean up old background processes +sub installForkCleanup { + my $session = shift; + print "\tInstalling Fork Cleanup workflow..." unless $quiet; + my $class = 'WebGUI::Workflow::Activity::RemoveOldForks'; + $session->config->addToArray('workflowActivities/None', $class); + my $wf = WebGUI::Workflow->new($session, 'pbworkflow000000000001'); + my $a = first { ref $_ eq $class } @{ $wf->getActivities }; + unless ($a) { + $a = $wf->addActivity($class); + $a->set(title => 'Remove Old Forks'); + }; + print "DONE!\n" unless $quiet; +} + # -------------- DO NOT EDIT BELOW THIS LINE -------------------------------- diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 34194743b..f5fe175f9 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; @@ -832,6 +835,58 @@ sub fixUrlFromParent { return $url; } +#------------------------------------------------------------------- + +=head2 forkWithStatusPage ($args) + +Kicks off a WebGUI::Fork running $method with $args (from the args hashref) +and redirects to a ProgressTree status page to show the progress. The +following arguments are required in $args: + +=head3 method + +The name of the WebGUI::Asset method to call + +=head3 args + +The arguments to pass that method (see WebGUI::Fork) + +=head3 plugin + +The WebGUI::Operation::Fork plugin to render (e.g. ProgressTree) + +=head3 title + +An key in Asset's i18n hash for the title of the rendered console page + +=head3 redirect + +The full url to redirect to after the fork has finished. + +=cut + +sub forkWithStatusPage { + my ( $self, $args ) = @_; + my $session = $self->session; + + my $process = WebGUI::Fork->start( $session, 'WebGUI::Asset', $args->{method}, $args->{args} ); + + if ( my $groupId = $args->{groupId} ) { + $process->setGroup($groupId); + } + + my $method = $session->form->get('proceed') || 'manageTrash'; + my $i18n = WebGUI::International->new( $session, 'Asset' ); + my $pairs = $process->contentPairs( + $args->{plugin}, { + title => $i18n->get( $args->{title} ), + icon => 'assets', + proceed => $args->{redirect} || '', + } + ); + $session->http->setRedirect( $self->getUrl($pairs) ); + return 'redirect'; +} ## end sub forkWithStatusPage #------------------------------------------------------------------- @@ -2555,6 +2610,33 @@ 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 = ? + }; + my @props = ($state, $self->session->user->userId, time); + $self->session->db->write( + $sql, [ + @props, + $self->getId, + ] + ); + @{$self->{_properties}}{qw(state stateChangedBy stateChanged)} = @props; + $self->purgeCache; +} #------------------------------------------------------------------- diff --git a/lib/WebGUI/Asset/Template.pm b/lib/WebGUI/Asset/Template.pm index 265d8a278..7749bc0a3 100644 --- a/lib/WebGUI/Asset/Template.pm +++ b/lib/WebGUI/Asset/Template.pm @@ -212,7 +212,7 @@ copy. sub duplicate { my $self = shift; - my $newTemplate = $self->SUPER::duplicate; + my $newTemplate = $self->SUPER::duplicate(@_); $newTemplate->update({isDefault => 0}); if ( my $storageId = $self->get('storageIdExample') ) { my $newStorage = WebGUI::Storage->get( $self->session, $storageId )->copy; 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..3185fd9de 100644 --- a/lib/WebGUI/AssetClipboard.pm +++ b/lib/WebGUI/AssetClipboard.pm @@ -49,6 +49,58 @@ sub canPaste { return $self->validParent($self->session); ##Lazy call to a class method } +#------------------------------------------------------------------- + +=head2 copyInFork ( $process, $args ) + +WebGUI::Fork method called by www_copy + +=cut + +sub copyInFork { + 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; + $tree->focus($id); + 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 +149,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 +188,10 @@ sub duplicate { keywords => $keywords, } ); + if (my $state = $options->{state}) { + $newAsset->setState($state); + } + return $newAsset; } @@ -218,11 +278,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 +294,64 @@ 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 pasteInFork ( ) + +WebGUI::Fork method called by www_pasteList + +=cut + +sub pasteInFork { + 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 = map { + my $list + = $_->getLineage( [ 'self', 'descendants' ], { statesToInclude => [ 'clipboard', 'clipboard-limbo' ] } ); + @$list; + } @roots; + + 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; +} ## end sub pasteInFork + + #------------------------------------------------------------------- =head2 www_copy ( ) @@ -255,89 +365,49 @@ 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; + $self->forkWithStatusPage({ + plugin => 'ProgressTree', + title => 'Copy Assets', + redirect => $redir, + method => 'copyInFork', + args => \%args } ); - 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; } #------------------------------------------------------------------- @@ -363,9 +433,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 +572,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)'}); } } @@ -656,26 +725,25 @@ the Asset Manager. 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 ); -} + return $session->privilege->insufficient() unless $self->canEdit && $session->form->validToken; + $self->forkWithStatusPage( { + plugin => 'ProgressTree', + title => 'Paste Assets', + redirect => $self->getUrl( + $form->get('proceed') eq 'manageAssets' + ? 'op=assetManager' + : () + ), + method => 'pasteInFork', + args => { + assetId => $self->getId, + list => [ $form->get('assetId') ], + } + } + ); +} ## end sub www_pasteList 1; diff --git a/lib/WebGUI/AssetExportHtml.pm b/lib/WebGUI/AssetExportHtml.pm index edc634760..dca2f5b53 100644 --- a/lib/WebGUI/AssetExportHtml.pm +++ b/lib/WebGUI/AssetExportHtml.pm @@ -23,7 +23,8 @@ use WebGUI::Exception; use WebGUI::Utility (); use WebGUI::Session; use URI::URL; -use Scope::Guard; +use Scope::Guard qw(guard); +use WebGUI::ProgressTree; =head1 NAME @@ -304,21 +305,53 @@ sub exportAsHtml { } sub exportBranch { - my $self = shift; - my $options = shift; - my $reportSession = shift; + my ($self, $options, $reportSession) = @_; + my $i18n = $reportSession && + WebGUI::International->new($self->session, 'Asset'); my $depth = $options->{depth}; my $indexFileName = $options->{indexFileName}; my $extrasUploadAction = $options->{extrasUploadAction}; my $rootUrlAction = $options->{rootUrlAction}; - my $exportedCount = 0; + my $report = $options->{report}; - my $i18n; - if ( $reportSession ) { - $i18n = WebGUI::International->new($self->session, 'Asset'); + unless ($report) { + if ($reportSession) { + # We got a report session and no report coderef, so we'll print + # messages out. NOTE: this is for backcompat, but I'm not sure we + # even need it any more. I think the only thing using it was the + # old iframe-based export status report. --frodwith + my %reports = ( + 'bad user privileges' => sub { + my $asset = shift; + my $url = $asset->getUrl; + $i18n->get('bad user privileges') . "\n$url" + }, + 'not exportable' => sub { + my $asset = shift; + my $fullPath = $asset->exportGetUrlAsPath; + "$fullPath skipped, not exportable
"; + }, + 'exporting page' => sub { + my $asset = shift; + my $fullPath = $asset->exportGetUrlAsPath; + sprintf $i18n->get('exporting page'), $fullPath; + }, + 'collateral notes' => sub { pop }, + 'done' => sub { $i18n->get('done') }, + ); + $report = sub { + my ($asset, $key, @args) = @_; + my $code = $reports{$key}; + my $message = $asset->$code(); + $reportSession->output->print($message, @args); + }; + } + else { + $report = sub {}; + } } - + my $exportedCount = 0; my $exportAsset = sub { my ( $assetId ) = @_; @@ -335,26 +368,18 @@ sub exportBranch { # skip this asset if we can't view it as this user. unless( $asset->canView ) { - if( $reportSession ) { - my $message = sprintf( $i18n->get('bad user privileges') . "\n") . $asset->getUrl; - $reportSession->output->print($message); - } + $asset->$report('bad user privileges'); next; } # skip this asset if it's not exportable. unless ( $asset->exportCheckExportable ) { - if ( $reportSession ) { - $reportSession->output->print("$fullPath skipped, not exportable
"); - } + $asset->$report('not exportable'); next; } # tell the user which asset we're exporting. - if ( $reportSession ) { - my $message = sprintf $i18n->get('exporting page'), $fullPath; - $reportSession->output->print($message); - } + $asset->$report('exporting page'); # try to write the file eval { $asset->exportWriteFile }; @@ -364,9 +389,25 @@ sub exportBranch { # next, tell the asset that we're exporting, so that it can export any # of its collateral or other extra data. - eval { $asset->exportAssetCollateral($asset->exportGetUrlAsPath, $options, $reportSession) }; - if($@) { - WebGUI::Error->throw(error => "failed to export asset collateral for URL " . $asset->getUrl . ": $@"); + { + # For backcompat we want to capture anything that + # exportAssetCollateral may have printed and report it to the + # coderef. We should get rid of this as soon as we're ready to + # break that api. + my $cs = $self->session->duplicate(); + open my $handle, '>', \my $output; + $cs->output->setHandle($handle); + my $guard = guard { + close $handle; + $cs->var->end; + $cs->close(); + $asset->$report('collateral notes', $output) if $output; + }; + my $path = $asset->exportGetUrlAsPath; + eval { $asset->exportAssetCollateral($path, $options, $cs) }; + if($@) { + WebGUI::Error->throw(error => "failed to export asset collateral for URL " . $asset->getUrl . ": $@"); + } } # we exported this one successfully, so count it @@ -376,19 +417,12 @@ sub exportBranch { $self->session->db->write( "UPDATE asset SET lastExportedAs = ? WHERE assetId = ?", [ $fullPath, $asset->getId ] ); - $self->updateHistory("exported"); + $asset->updateHistory('exported'); # tell the user we did this asset correctly - if ( $reportSession ) { - $reportSession->output->print($i18n->get('done')); - } - - #use Devel::Cycle; - #warn "CHECKING on " . ref( $asset ) . ' ID: ' . $asset->getId . "\n"; - #find_cycle( $asset ); + $asset->$report('done'); }; - my $assetIds = $self->exportGetDescendants(undef, $depth); foreach my $assetId ( @{$assetIds} ) { $exportAsset->( $assetId ); @@ -625,6 +659,44 @@ sub exportGetUrlAsPath { #------------------------------------------------------------------- +=head2 exportInFork + +Intended to be called by WebGUI::Fork. Runs exportAsHtml on the +specified asset and keeps a json structure as the status. + +=cut + +sub exportInFork { + my ( $process, $args ) = @_; + my $session = $process->session; + my $self = WebGUI::Asset->new( $session, delete $args->{assetId} ); + $args->{indexFileName} = delete $args->{index}; + my $assetIds = $self->exportGetDescendants( undef, $args->{depth} ); + my $tree = WebGUI::ProgressTree->new( $session, $assetIds ); + my %reports = ( + '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' ); + }, + 'not exportable' => sub { + $tree->failure( shift, 'Not Exportable' ); + }, + ); + $args->{report} = sub { + my ( $asset, $key, @args ) = @_; + my $code = $reports{$key}; + $code->( $asset->getId, @args ); + $process->update( sub { $tree->json } ); + }; + $self->exportAsHtml($args); + $tree->focus(undef); + $process->update( $tree->json ); +} ## end sub exportInFork + +#------------------------------------------------------------------- + =head2 exportSymlinkExtrasUploads ( [ session ] ) Class or object method. Sets up the extras and uploads symlinks. @@ -935,16 +1007,25 @@ Displays the export status page =cut sub www_exportStatus { - my $self = shift; - return $self->session->privilege->insufficient() unless ($self->session->user->isInGroup(13)); - my $i18n = WebGUI::International->new($self->session, "Asset"); - my $iframeUrl = $self->getUrl('func=exportGenerate'); - foreach my $formVar (qw/index depth userId extrasUploadsAction rootUrlAction exportUrl/) { - $iframeUrl = $self->session->url->append($iframeUrl, $formVar . '=' . $self->session->form->process($formVar)); - } - - my $output = ''; - $self->getAdminConsole->render($output, $i18n->get('Page Export Status'), "Asset"); + my $self = shift; + my $session = $self->session; + return $session->privilege->insufficient + unless $session->user->isInGroup(13); + my $form = $session->form; + my @vars = qw( + index depth userId extrasUploadsAction rootUrlAction exportUrl + ); + $self->forkWithStatusPage({ + plugin => 'ProgressTree', + title => 'Page Export Status', + method => 'exportInFork', + groupId => 13, + args => { + assetId => $self->getId, + map { $_ => scalar $form->get($_) } @vars + } + } + ); } #------------------------------------------------------------------- diff --git a/lib/WebGUI/AssetTrash.pm b/lib/WebGUI/AssetTrash.pm index f6c7110a5..26e74f8a5 100644 --- a/lib/WebGUI/AssetTrash.pm +++ b/lib/WebGUI/AssetTrash.pm @@ -200,6 +200,63 @@ sub purge { return 1; } +#------------------------------------------------------------------- + +=head2 purgeInFork + +WebGUI::Fork method called by www_purgeList + +=cut + +sub purgeInFork { + my ( $process, $list ) = @_; + my $session = $process->session; + my @roots = grep { $_ && $_->canEdit } + map { WebGUI::Asset->newPending( $session, $_ ) } @$list; + + my @ids = map { + my $list = $_->getLineage( + [ 'self', 'descendants' ], { + statesToInclude => [qw(published clipboard clipboard-limbo trash trash-limbo)], + statusToInclude => [qw(approved archived pending)], + } + ); + @$list; + } @roots; + + my $tree = WebGUI::ProgressTree->new( $session, \@ids ); + my $patch = Monkey::Patch::patch_class( + 'WebGUI::Asset', + 'purge', + sub { + my ( $purge, $self, $options ) = @_; + my $id = $self->getId; + my $zero = ''; + $tree->focus($id); + $options ||= {}; + local $options->{outputSub} = sub { $zero .= $_[0] }; + my $ret = eval { $self->$purge($options) }; + my $e = $@; + $tree->focus($id); + + if ($e) { + $tree->failure( $id, 'Died' ); + $tree->note( $id, $e ); + } + elsif ( !$ret ) { + $tree->failure( $id, 'Failed' ); + $tree->note( $id, $zero ); + } + else { + $tree->success($id); + } + $process->update( sub { $tree->json } ); + die $e if $e; + return $ret; + } + ); + $_->purge for @roots; +} ## end sub purgeInFork #------------------------------------------------------------------- @@ -246,7 +303,15 @@ sub trash { return undef; } - my $assetIter = $self->getLineageIterator(['self','descendants']); + my $assetIter = $self->getLineageIterator( + ['self','descendants'], { + statesToInclude => [qw(published clipboard clipboard-limbo trash trash-limbo)], + statusToInclude => [qw(approved archived pending)], + } + ); + my $rootId = $self->getId; + my $db = $session->db; + $db->beginTransaction; while ( 1 ) { my $asset; eval { $asset = $assetIter->() }; @@ -263,7 +328,18 @@ sub trash { $outputSub->($i18n->get('Clearing cache')); $asset->purgeCache; $asset->updateHistory("trashed"); + if ($asset->getId eq $rootId) { + $asset->setState('trash'); + # setState will take care of _properties in $asset, but not in + # $self (whooops!), so we need to manually update. + my @keys = qw(state stateChangedBy stateChanged); + @{$self->{_properties}}{@keys} = @{$asset->{_properties}}{@keys}; + } + else { + $asset->setState('trash-limbo'); + } } + $db->commit; # Trash any shortcuts to this asset my $shortcuts @@ -273,19 +349,53 @@ sub trash { $shortcut->trash({ outputSub => $outputSub, }); } - # Raw database work is more efficient than $asset->update - my $db = $session->db; - $db->beginTransaction; - $outputSub->($i18n->get('Clearing asset tables')); - $db->write("update asset set state='trash-limbo' where lineage like ?",[$self->get("lineage").'%']); - $db->write("update asset set state='trash', stateChangedBy=?, stateChanged=? where assetId=?",[$session->user->userId, time(), $self->getId]); - $db->commit; - - # Update ourselves since we didn't use update() - $self->{_properties}{state} = "trash"; return 1; } +#------------------------------------------------------------------- + +=head2 trashInFork + +WebGUI::Fork method called by www_deleteList and www_delete to move assets +into the trash. + +=cut + +sub trashInFork { + my ( $process, $list ) = @_; + my $session = $process->session; + my @roots = grep { $_->canEdit && $_->canEditIfLocked } + map { + eval { WebGUI::Asset->newPending( $session, $_ ) } + } @$list; + + my @ids = map { + my $list = $_->getLineage( + [ 'self', 'descendants' ], { + statesToInclude => [qw(published clipboard clipboard-limbo trash trash-limbo)], + statusToInclude => [qw(approved archived pending)], + } + ); + @$list; + } @roots; + + my $tree = WebGUI::ProgressTree->new( $session, \@ids ); + my $patch = Monkey::Patch::patch_class( + 'WebGUI::Asset', + 'setState', + sub { + my ( $setState, $self, $state ) = @_; + my $id = $self->getId; + $tree->focus($id); + my $ret = $self->$setState($state); + $tree->success($id); + $process->update(sub { $tree->json }); + return $ret; + } + ); + $_->trash() for @roots; +} ## end sub trashInFork + require WebGUI::Workflow::Activity::DeleteExportedFiles; sub _invokeWorkflowOnExportedFiles { my $self = shift; @@ -315,7 +425,7 @@ sub _invokeWorkflowOnExportedFiles { =head2 www_delete -Moves self to trash, returns www_view() method of Container or Parent if canEdit. +Moves self to trash in fork, redirects to Container or Parent if canEdit. Otherwise returns AdminConsole rendered insufficient privilege. =cut @@ -325,13 +435,19 @@ sub www_delete { return $self->session->privilege->insufficient() unless ($self->canEdit && $self->canEditIfLocked); return $self->session->privilege->vitalComponent() if $self->get('isSystem'); return $self->session->privilege->vitalComponent() if (isIn($self->getId, $self->session->setting->get("defaultPage"), $self->session->setting->get("notFoundPage"))); - $self->trash; + my $asset = $self->getContainer; if ($self->getId eq $asset->getId) { $asset = $self->getParent; } - $self->session->asset($asset); - return $asset->www_view; + $self->forkWithStatusPage({ + plugin => 'ProgressTree', + title => 'Delete Assets', + redirect => $asset->getUrl, + method => 'trashInFork', + args => [ $self->getId ], + } + ); } #------------------------------------------------------------------- @@ -347,31 +463,20 @@ by the form variable C. =cut sub www_deleteList { - my $self = shift; - my $session = $self->session; - my $pb = WebGUI::ProgressBar->new($session); - my $i18n = WebGUI::International->new($session, 'Asset'); - my $form = $session->form; - my @assetIds = $form->param('assetId'); - $pb->start($i18n->get('Delete Assets'), $session->url->extras('adminConsole/assets.gif')); - return $self->session->privilege->insufficient() unless $session->form->validToken; - ASSETID: foreach my $assetId (@assetIds) { - my $asset = eval { WebGUI::Asset->newPending($session,$assetId); }; - if ($@) { - $pb->update(sprintf $i18n->get('Error getting asset with assetId %s'), $assetId); - next ASSETID; + my $self = shift; + my $session = $self->session; + my $form = $session->form; + return $session->privilege->insufficient() unless $session->form->validToken; + my $method = $form->get('proceed') || 'manageTrash'; + $self->forkWithStatusPage({ + plugin => 'ProgressTree', + title => 'Delete Assets', + redirect => $self->getUrl("func=$method"), + method => 'trashInFork', + args => [ $form->get('assetId') ], } - if (! ($asset->canEdit && $asset->canEditIfLocked) ) { - $pb->update(sprintf $i18n->get('You cannot edit the asset %s, skipping'), $asset->getTitle); - } - else { - $asset->trash({outputSub => sub { $pb->update(@_); } }); - } - } - my $method = ($session->form->process("proceed")) ? $session->form->process('proceed') : 'manageTrash'; - $pb->finish($self->getUrl('func='.$method)); -} - + ); +} ## end sub www_deleteList #------------------------------------------------------------------- @@ -478,29 +583,18 @@ Returns insufficient privileges unless the submitted form passes the validToken sub www_purgeList { my $self = shift; my $session = $self->session; + my $form = $session->form; return $session->privilege->insufficient() unless $session->form->validToken; - my $pb = WebGUI::ProgressBar->new($session); - my $i18n = WebGUI::International->new($session, 'Asset'); - $pb->start($i18n->get('purge'), $session->url->extras('adminConsole/assets.gif')); - - ASSETID: foreach my $id ($session->form->param("assetId")) { - my $asset = eval { WebGUI::Asset->newPending($session,$id); }; - if ($@) { - $pb->update(sprintf $i18n->get('Error getting asset with assetId %s'), $id); - next ASSETID; + my $method = $form->get('proceed') || 'manageTrash'; + $method .= ';systemTrash=1' if $form->get('systemTrash'); + $self->forkWithStatusPage({ + plugin => 'ProgressTree', + title => 'purge', + redirect => $self->getUrl("func=$method"), + method => 'purgeInFork', + args => [ $form->get('assetId') ], } - if (! $asset->canEdit) { - $pb->update(sprintf $i18n->get('You cannot edit the asset %s, skipping'), $asset->getTitle); - } - else { - $asset->purge({outputSub => sub { $pb->update(@_); } }); - } - } - my $method = ($session->form->process("proceed")) ? $session->form->process('proceed') : 'manageTrash'; - if ($session->form->process('systemTrash') ) { - $method .= ';systemTrash=1'; - } - $pb->finish($self->getUrl('func='.$method)); + ); } #------------------------------------------------------------------- diff --git a/lib/WebGUI/Fork.pm b/lib/WebGUI/Fork.pm new file mode 100644 index 000000000..5be0d2694 --- /dev/null +++ b/lib/WebGUI/Fork.pm @@ -0,0 +1,668 @@ +package WebGUI::Fork; + +use warnings; +use strict; + +use File::Spec; +use JSON; +use POSIX; +use Config; +use IO::Pipe; +use WebGUI::Session; +use WebGUI::Pluggable; +use Time::HiRes qw(sleep); + +=head1 NAME + +WebGUI::Fork + +=head1 DESCRIPTION + +Safely and portably spawn a long running process that you can check the +status of. + +=head1 SYNOPSIS + + package WebGUI::Some::Class; + + sub doWork { + my ($process, $data) = @_; + $process->update("Starting..."); + ... + $process->update("About half way done..."); + ... + $process->update("Finished!"); + } + + sub www_doWork { + my $self = shift; + my $session = $self->session; + my $process = WebGUI::Fork->start( + $session, 'WebGUI::Some::Class', 'doWork', { some => 'data' } + ); + # See WebGUI::Operation::Fork + my $pairs = $process->contentPairs('DoWork'); + $session->http->setRedirect($self->getUrl($pairs)); + return 'redirect'; + } + + package WebGUI::Operation::Fork::DoWork; + + sub handler { + my $process = shift; + my $session = $process->session; + return $session->style->userStyle($process->status); + + # or better yet, an ajaxy page that polls. + } + + +=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 canView ($user?) + +Returns whether the current user (or the user passed in, if there is one) has +permission to view the status of the fork. By default, only admins can view, +but see setGroup. + +=cut + +sub canView { + my $self = shift; + my $session = $self->session; + my $user = shift || $session->user; + $user = WebGUI::User->new( $session, $user ) + unless eval { $user->isa('WebGUI::User') }; + return + $user->isAdmin + || $user->userId eq $self->getUserId + || $user->isInGroup( $self->getGroupId ); +} + +#------------------------------------------------------------------- + +=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). + +$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, $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 inserts it into the db. + +=cut + +sub create { + my ( $class, $session ) = @_; + my $id = $session->id->generate; + my %data = ( userId => $session->user->userId ); + $session->db->setRow( $class->tableName, 'id', \%data, $id ); + bless { session => $session, id => $id }, $class; +} + +#----------------------------------------------------------------- + +=head2 daemonize ( $stdin, $sub ) + +Internal lass method. Runs the given $sub in daemon, and prints $stdin to its +stdin. + +=cut + +sub daemonize { + my ( $class, $stdin, $sub ) = @_; + my $pid = fork(); + die "Cannot fork: $!" unless defined $pid; + if ($pid) { + + # The child process will fork again and exit immediately, so we can + # wait for it (and thus not have zombie processes). + waitpid( $pid, 0 ); + return; + } + + eval { + + # detach from controlling terminal, get us into a new process group + die "Cannot become session leader: $!" if POSIX::setsid() < 0; + + # Fork again so we never get a controlling terminal + my $worker = IO::Pipe->new; + my $pid = fork(); + die "Child cannot fork: $!" unless defined $pid; + + # We don't want to call any destructors, as it would mess with the + # parent's mysql connection, etc. + if ($pid) { + $worker->writer; + $worker->printflush($stdin); + POSIX::_exit(0); + } + + # We're now in the final target process. STDIN should be whatever the + # parent printed to us, and all output should go to /dev/null. + $worker->reader(); + open STDIN, '<&', $worker or die "Cannot dup stdin: $!"; + open STDOUT, '>', '/dev/null' or die "Cannot write /dev/null: $!"; + open STDERR, '>&', \*STDOUT or die "Cannot dup stdout: $!"; + + # Standard daemon-y things... + $SIG{HUP} = 'IGNORE'; + chdir '/'; + umask 0; + + # Forcibly close any non-std open file descriptors that remain + my $max = POSIX::sysconf(&POSIX::_SC_OPEN_MAX) || 1024; + POSIX::close($_) for ( $^F .. $max ); + + # Do whatever we're supposed to do + &$sub(); + }; + + POSIX::_exit( $@ ? -1 : 0 ); +} ## end sub daemonize + +#----------------------------------------------------------------- + +=head2 delete ( ) + +Clean up the information for this process from the database. + +=cut + +sub delete { + my $self = shift; + $self->session->db->deleteRow( $self->tableName, 'id', $self->getId ); +} + +#----------------------------------------------------------------- + +=head2 endTime ( ) + +Returns the epoch time indicating when the subroutine passed to run() finished +executing, or undef if it hasn't finished. Note that even if the sub passed +to run dies, an endTime will be recorded. + +=cut + +sub endTime { $_[0]->get('endTime') } + +#----------------------------------------------------------------- + +=head2 error ( $msg ) + +Call this to record an error status. You probably shouldn't, though -- just +dying from your subroutine will cause this to be set. + +=cut + +sub error { $_[0]->set( { error => $_[1] } ) } + +#----------------------------------------------------------------- + +=head2 finish ( ) + +Mark the process as being finished. This is called for you when your +subroutine is finished. If update() wasn't computed on the last call, it will +be computed now. + +=cut + +sub finish { + my $self = shift; + my %props = ( finished => 1 ); + if ( my $calc = delete $self->{delay} ) { + $props{status} = $calc->(); + $props{latch} = 0; + } + $props{endTime} = time(); + $self->set( \%props ); +} + +#----------------------------------------------------------------- + +=head2 forkAndExec ($request) + +Internal method. Forks and execs a new perl process to run $request. This is +used as a fallback if the master daemon runner is not working. + +=cut + +sub forkAndExec { + my ( $self, $request ) = @_; + my $id = $self->getId; + my $class = ref $self; + my $json = JSON::encode_json($request); + my @inc = map {"-I$_"} map { File::Spec->rel2abs($_) } grep { !ref } @INC; + my @argv = (@inc, "-M$class", "-e$class->runCmd()" ); + $class->daemonize( + $json, + sub { + exec ($Config{perlpath}, @argv) or die "Could not exec: $!"; + } + ); +} + +#----------------------------------------------------------------- + +=head2 get ( @keys ) + +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, 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 + +sub get { + my ( $self, @keys ) = @_; + my $db = $self->session->db; + my $dbh = $db->dbh; + my $tbl = $dbh->quote_identifier( $self->tableName ); + my $key + = @keys + ? join( ',', map { $dbh->quote_identifier($_) } @keys ) + : '*'; + my $id = $dbh->quote( $self->getId ); + my @values = $db->quickArray("SELECT $key FROM $tbl WHERE id = $id"); + return ( @values > 1 ) ? @values : $values[0]; +} + +#----------------------------------------------------------------- + +=head2 getError ( ) + +If the process died, this will be set to stringified $@. + +=cut + +sub getError { $_[0]->get('error') } + +#----------------------------------------------------------------- + +=head2 getGroupId + +Returns the group ID (not the actual WebGUI::Group) of users who are allowed +to view this process. + +=cut + +sub getGroupId { + my $id = $_[0]->get('groupId'); + return $id || 3; +} + +#----------------------------------------------------------------- + +=head2 getId ( ) + +The unique id for this fork. Note: this is NOT the pid, but a WebGUI guid. + +=cut + +sub getId { shift->{id} } + +#----------------------------------------------------------------- + +=head2 getStatus() + +Signals the fork that it should report its next status, then polls at a +configurable, fractional interval (default: .1 seconds) waiting for the fork +to claim that its status has been updated. Returns the updated status. See +setWait() for a way to change the interval (or disable the waiting procedure +entirely). We will only wait for a maximum of 100 intervals. + +=cut + +sub getStatus { + my $self = shift; + if ( my $interval = $self->{interval} ) { + $self->set( { latch => 1 } ); + my $maxWait; + while ($maxWait++ < 100) { + sleep $interval; + my ( $finished, $latch ) = $self->get( 'finished', 'latch' ); + last if $finished || !$latch; + } + } + return $self->get('status'); +} + +#----------------------------------------------------------------- + +=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 +is for this to be called once at server startup time, after you've preloaded +modules and before you start listening for requests. Returns a filehandle that +can be used to print requests to the master process, and which you almost +certainly shouldn't use (it's mostly for testing). + +=cut + +my $pipe; + +sub init { + my $class = shift; + $pipe = IO::Pipe->new; + + my $pid = fork(); + die "Cannot fork: $!" unless defined $pid; + + if ($pid) { + $pipe->writer; + return $pipe; + } + + $0 = 'webgui-fork-master'; + $pipe->reader; + local $/ = "\x{0}"; + while ( my $request = $pipe->getline ) { + chomp $request; + eval { + $class->daemonize( $request, sub { $class->runCmd } ); + }; + } + exit 0; +} ## end sub init + +#----------------------------------------------------------------- + +=head2 isFinished ( ) + +A simple flag indicating that the fork is no longer running. + +=cut + +sub isFinished { $_[0]->get('finished') } + +#----------------------------------------------------------------- + +=head2 new ( $session, $id ) + +Returns an object capable of checking on the status of the fork indicated by +$id. Returns undef if there is no such process. + +=cut + +sub new { + my ( $class, $session, $id ) = @_; + my $db = $session->db; + my $tbl = $db->dbh->quote_identifier( $class->tableName ); + my $sql = "SELECT COUNT(*) FROM $tbl WHERE id = ?"; + my $exists = $db->quickScalar( $sql, [$id] ); + return $exists + ? bless( { session => $session, id => $id, interval => .1 }, $class ) + : undef; +} + +#----------------------------------------------------------------- + +=head2 session () + +Get the WebGUI::Session this process was created with. Note: this is safe to +call in the child process, as it is a duplicated session (same session id) and +doesn't share any handles with the parent process. + +=cut + +sub session { $_[0]->{session} } + +#----------------------------------------------------------------- + +=head2 set ($properties) + +Updates the database row with the properties given by the $properties hashref. +See get() for a list of valid keys. + +=cut + +sub set { + my ( $self, $values ) = @_; + my %row = ( id => $self->getId, %$values ); + $self->session->db->setRow( $self->tableName, 'id', \%row ); +} + +#----------------------------------------------------------------- + +=head2 setGroup($groupId) + +Allow the given group (in addition to admins) the ability to check on the +status of this process + +=cut + +sub setGroup { + my ( $self, $groupId ) = @_; + $groupId = eval { $groupId->getId } || $groupId; + $self->set( { groupId => $groupId } ); +} + +#----------------------------------------------------------------- + +=head2 request ($module, $subname, $data) + +Internal method. Generates a hashref suitable for passing to runRequest. + +=cut + +sub request { + my ( $self, $module, $subname, $data ) = @_; + my $session = $self->session; + my $config = $session->config; + return { + webguiRoot => $config->getWebguiRoot, + configFile => $config->getFilename, + sessionId => $session->getId, + module => $module, + subname => $subname, + id => $self->getId, + data => $data, + }; +} + +#----------------------------------------------------------------- + +=head2 runCmd () + +Internal class method. Decodes json off of stdin and passes it to runRequest. + +=cut + +sub runCmd { + my $class = shift; + my $slurp = do { local $/; }; + $class->runRequest( JSON::decode_json($slurp) ); +} + +#----------------------------------------------------------------- + +=head2 runRequest ($hashref) + +Internal class method. Expects a hash of arguments describing what to run. + +=cut + +sub runRequest { + my ( $class, $args ) = @_; + my ( $root, $config, $sid ) = @{$args}{qw(webguiRoot configFile sessionId)}; + my $session = WebGUI::Session->open( $root, $config, undef, undef, $sid ); + my $id = $args->{id}; + my $self = $class->new( $session, $id ); + $self->set( { startTime => time } ); + $0 = "webgui-fork-$id"; + eval { + my ( $module, $subname, $data ) = @{$args}{qw(module subname data)}; + WebGUI::Pluggable::run( $module, $subname, [ $self, $data ] ); + }; + $self->error($@) if $@; + $self->finish(); +} + +#----------------------------------------------------------------- + +=head2 sendRequestToMaster ($request) + +Internal method. Attempts to send a request to the master daemon runner. +Returns 1 on success and 0 on failure. + +=cut + +sub sendRequestToMaster { + my ( $self, $request ) = @_; + my $json = JSON::encode_json($request); + eval { + die 'pipe' unless $pipe && $pipe->isa('IO::Handle'); + local $SIG{PIPE} = sub { die 'pipe' }; + $pipe->printflush("$json\x{0}") or die 'pipe'; + }; + return 1 unless $@; + undef $pipe; + $self->session->log->error('Problems talking to master daemon process. Please restart the web server.'); + return 0; +} + +#----------------------------------------------------------------- + +=head2 setWait ( $interval ) + +Use this to control the pace at which getStatus will poll for updated +statuses. By default, this is a tenth of a second. If you set it to 0, +getStatus will still signal the fork for an update, but will take whatever is +currently recorded as the status and return immediately. + +=cut + +sub setWait { $_[0]->{interval} = $_[1] } + +#----------------------------------------------------------------- + +=head2 start ( $session, $module, $subname, $data ) + +Class method. Executes $module::subname in a forked process with ($process, +$data) as its arguments. The only restriction on $data is that it be +serializable by JSON. + +=head3 $0 + +The process name (as it appears in ps) will be set to webgui-fork-$id, +where $id is the value returned by $process->getId. It thus won't look like a +modperl process to anyone monitoring the process table (wremonitor.pl, for +example). + +=cut + +sub start { + my ( $class, $session, $module, $subname, $data ) = @_; + my $self = $class->create($session); + my $request = $self->request( $module, $subname, $data ); + $self->sendRequestToMaster($request) or $self->forkAndExec($request); + return $self; +} + +#----------------------------------------------------------------- + +=head2 startTime ( ) + +Returns the time this process started running in epoch format. + +=cut + +sub startTime { $_[0]->get('startTime') } + +#----------------------------------------------------------------- + +=head2 tableName ( ) + +Class method: a constant, for convenience. The name of the table that process +data is stored in. + +=cut + +sub tableName {'Fork'} + +#----------------------------------------------------------------- + +=head2 update ( $msg ) + +Set a new status for the fork. This can be anything, and will overwrite the +old status. JSON is recommended for complex statuses. Optionally, $msg can +be a subroutine that returns the new status -- if your status may take a long +time to compute, you should use this, as you may be able to avoid computing +some (or all) of your status updates, depending on how often they're being +asked for. See the getStatus method for details. + +=cut + +sub update { + my ( $self, $msg ) = @_; + if ( ref $msg eq 'CODE' ) { + if ( $self->get('latch') ) { + $msg = $msg->(); + } + else { + $self->{delay} = $msg; + return; + } + } + delete $self->{delay}; + $self->set( { latch => 0, status => $msg } ); +} + +1; diff --git a/lib/WebGUI/Fork/ProgressBar.pm b/lib/WebGUI/Fork/ProgressBar.pm new file mode 100644 index 000000000..4969980bb --- /dev/null +++ b/lib/WebGUI/Fork/ProgressBar.pm @@ -0,0 +1,140 @@ +package WebGUI::Fork::ProgressBar; + +=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 NAME + +WebGUI::Fork::ProgressBar + +=head1 DESCRIPTION + +Renders an admin console page that polls ::Status to draw a simple progress +bar along with some kind of message. + +=head1 SUBROUTINES + +These subroutines are available from this package: + +=cut + +use Template; +use HTML::Entities; +use JSON; + +my $template = <<'TEMPLATE'; +
[% i18n('WebGUI', 'Loading...') %]
+ + +TEMPLATE + +#------------------------------------------------------------------- + +=head2 handler ( process ) + +See WebGUI::Operation::Fork. + +=cut + +sub handler { renderBar( shift, $template ) } + +#------------------------------------------------------------------- + +=head2 renderBar ( process, template ) + +Renders $template, passing a "params" variable to it that is JSON of a +statusUrl to poll and a page to redirect to and an i18n function. Includes +WebGUI.Fork.redirect, poll, and ProgressBar js and CSS (as well as all their +YUI dependancies), and puts the whole template inside an adminConsole rendered +based off some form parameters. + +=cut + +sub renderBar { + my ( $process, $template ) = @_; + my $session = $process->session; + my $url = $session->url; + my $form = $session->form; + my $style = $session->style; + my $tt = Template->new; + my %vars = ( + i18n => sub { + my ($namespace, $key) = @_; + return WebGUI::International->new($session, $namespace)->get($key); + }, + params => JSON::encode_json( { + statusUrl => $url->page( $process->contentPairs('Status') ), + redirect => scalar $form->get('proceed'), + } + ), + ); + $tt->process( \$template, \%vars, \my $content ) or die $tt->error; + + my $console = WebGUI::AdminConsole->new( $session, $form->get('icon') ); + $style->setLink( $url->extras("Fork/ProgressBar.css"), { rel => 'stylesheet' } ); + $style->setScript( $url->extras("$_.js") ) + for ( ( + map {"yui/build/$_"} + qw( + yahoo/yahoo-min + dom/dom-min + json/json-min + event/event-min + connection/connection_core-min + ) + ), + 'Fork/ProgressBar', + 'Fork/poll', + 'Fork/redirect' + ); + return $console->render( $content, encode_entities( $form->get('title') ) ); +} ## end sub renderBar + +1; diff --git a/lib/WebGUI/Fork/ProgressTree.pm b/lib/WebGUI/Fork/ProgressTree.pm new file mode 100644 index 000000000..313e52ddc --- /dev/null +++ b/lib/WebGUI/Fork/ProgressTree.pm @@ -0,0 +1,155 @@ +package WebGUI::Fork::ProgressTree; + +=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 NAME + +WebGUI::Fork::ProgressTree + +=head1 DESCRIPTION + +Renders an admin console page that polls ::Status to draw a friendly graphical +representation of how progress on a tree of assets is coming along. + +=head1 SUBROUTINES + +These subroutines are available from this package: + +=cut + +use Template; +use HTML::Entities; +use JSON; +use WebGUI::Fork::ProgressBar; + +my $template = <<'TEMPLATE'; +
[% i18n('WebGUI', 'Loading...') %]
+ + +TEMPLATE + +my $stylesheet = <<'STYLESHEET'; + +STYLESHEET + +#------------------------------------------------------------------- + +=head2 handler ( process ) + +See WebGUI::Operation::Fork. + +=cut + +sub handler { + my $process = shift; + my $session = $process->session; + my $style = $session->style; + my $url = $session->url; + $style->setRawHeadTags($stylesheet); + $style->setScript($url->extras('underscore/underscore-min.js')); + WebGUI::Fork::ProgressBar::renderBar($process, $template); +} + +1; diff --git a/lib/WebGUI/Fork/Status.pm b/lib/WebGUI/Fork/Status.pm new file mode 100644 index 000000000..06c2ebd3b --- /dev/null +++ b/lib/WebGUI/Fork/Status.pm @@ -0,0 +1,84 @@ +package WebGUI::Fork::Status; + +use JSON; + +=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 NAME + +WebGUI::Fork::Status + +=head1 DESCRIPTION + +Returns a json response of the following form: + + { + "finished" : true, + "elapsed" : 10, + "status" : "whatever is in the status field. Could be anything.", + "error" : "whatever is in the error field" + } + +Note that if your status is JSON, you'll have to decode that seperately, so +something like: + + decoded = JSON.parse(r.responseText); + status = JSON.parse(decoded.status); + +Finished is obviously true or false. Notably, it will be true in the error +case: so to status.finished && !status.error means successful completion. +Error will only be present if the process died for some reason. + +Status will always be present, mostly so you can see what the last status was +before it died. + +Elapsed will be the number of seconds since the process started (or until the +process finished, if it is finished). + +=head1 SUBROUTINES + +These subroutines are available from this package: + +=cut + +#------------------------------------------------------------------- + +=head2 handler ( process ) + +See the synopsis for what kind of response this generates. + +=cut + +sub handler { + my $process = shift; + my $status = $process->getStatus; + my ( $finished, $startTime, $endTime, $error ) = $process->get( 'finished', 'startTime', 'endTime', 'error' ); + + $endTime = time() unless $finished; + + my %status = ( + status => $status, + elapsed => ( $endTime - $startTime ), + finished => ( $finished ? \1 : \0 ), + ); + $status{error} = $error if $finished; + $process->session->http->setMimeType('text/plain'); + JSON::encode_json( \%status ); +} ## end sub handler + +1; diff --git a/lib/WebGUI/Operation.pm b/lib/WebGUI/Operation.pm index 4c102fb75..7c9a9204b 100644 --- a/lib/WebGUI/Operation.pm +++ b/lib/WebGUI/Operation.pm @@ -76,6 +76,7 @@ Returns a hash reference containing operation and package names. sub getOperations { return { + 'fork' => 'Fork', 'killSession' => 'ActiveSessions', 'viewActiveSessions' => 'ActiveSessions', diff --git a/lib/WebGUI/Operation/Fork.pm b/lib/WebGUI/Operation/Fork.pm new file mode 100644 index 000000000..ceeadda54 --- /dev/null +++ b/lib/WebGUI/Operation/Fork.pm @@ -0,0 +1,74 @@ +package WebGUI::Operation::Fork; + +=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; + +use WebGUI::Fork; +use WebGUI::Pluggable; + +=head1 NAME + +WebGUI::Operation::Fork + +=head1 DESCRIPTION + +URL dispatching for WebGUI::Fork monitoring + +=head1 SUBROUTINES + +These subroutines are available from this package: + +=cut + +#------------------------------------------------------------------- + +=head2 www_fork ( session ) + +Dispatches to the proper module based on the module form parameter if op is +fork. Returns insufficient privilege page if the user doesn't pass canView on +the process before dispatching. + +=cut + +sub www_fork { + my $session = shift; + my $form = $session->form; + my $module = $form->get('module') || 'Status'; + my $pid = $form->get('pid') || return undef; + + my $process = WebGUI::Fork->new( $session, $pid ); + + return $session->privilege->insufficient unless $process->canView; + + my $log = $session->log; + + unless ($process) { + $log->error("Tried to get info for nonexistent process $pid"); + return undef; + } + + my $output = eval { WebGUI::Pluggable::run( "WebGUI::Fork::$module", 'handler', [$process] ); }; + + if ($@) { + $log->error($@); + return undef; + } + + return $output; +} ## end sub www_fork + +1; diff --git a/lib/WebGUI/Operation/VersionTag.pm b/lib/WebGUI/Operation/VersionTag.pm index 4f2caedc2..214b15af6 100644 --- a/lib/WebGUI/Operation/VersionTag.pm +++ b/lib/WebGUI/Operation/VersionTag.pm @@ -21,6 +21,9 @@ use WebGUI::International; use WebGUI::VersionTag; use WebGUI::HTMLForm; use WebGUI::Paginator; +use WebGUI::Fork; +use Monkey::Patch; +use JSON; =head1 NAME @@ -137,6 +140,50 @@ sub getVersionTagOptions { return %tag; } +#---------------------------------------------------------------------------- + +=head2 rollbackInFork ($process, $tagId) + +WebGUI::Fork method called by www_rollbackVersionTag + +=cut + +sub rollbackInFork { + my ( $process, $tagId ) = @_; + my $session = $process->session; + my $tag = WebGUI::VersionTag->new( $session, $tagId ); + my %status = ( + finished => 0, + total => $process->session->db->quickScalar( 'SELECT count(*) FROM assetData WHERE tagId = ?', [$tagId] ), + message => '', + ); + my $update = sub { + $process->update( sub { JSON::encode_json( \%status ) } ); + }; + my $patch = Monkey::Patch::patch_class( + 'WebGUI::Asset', + 'purgeRevision', + sub { + my $purgeRevision = shift; + my $self = shift; + $self->$purgeRevision(@_); + $status{finished}++; + $update->(); + } + ); + $tag->rollback( { + outputSub => sub { + $status{message} = shift; + $update->(); + } + } + ); + + # need to get at least one of these in for the degenerate case of no + # revisions in tag + $update->(); +} ## end sub rollbackInFork + #------------------------------------------------------------------- =head2 www_approveVersionTag ( session ) @@ -853,16 +900,27 @@ sub www_rollbackVersionTag { return $session->privilege->adminOnly() unless canView($session); my $tagId = $session->form->process("tagId"); return $session->privilege->vitalComponent() if ($tagId eq "pbversion0000000000001"); - my $pb = WebGUI::ProgressBar->new($session); - my $i18n = WebGUI::International->new($session, 'VersionTag'); - $pb->start($i18n->get('rollback version tag'), $session->url->extras('adminConsole/versionTags.gif')); - if ($tagId) { - my $tag = WebGUI::VersionTag->new($session, $tagId); - $tag->rollback({ outputSub => sub { $pb->update(@_) }, }) if defined $tag; - } + + my $process = WebGUI::Fork->start( + $session, 'WebGUI::Operation::VersionTag', 'rollbackInFork', $tagId + ); + + my $i18n = WebGUI::International->new($session, 'VersionTag'); my $method = $session->form->process("proceed"); $method = $method eq "manageCommittedVersions" ? $method : 'manageVersions'; - $pb->finish(WebGUI::Asset->getDefault($session)->getUrl('op='.$method)); + my $redir = WebGUI::Asset->getDefault($session)->getUrl("op=$method"); + $session->http->setRedirect( + $session->url->page( + $process->contentPairs( + 'ProgressBar', { + icon => 'versions', + title => $i18n->get('rollback version tag'), + proceed => $redir, + } + ) + ) + ); + return 'redirect'; } 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/lib/WebGUI/Workflow/Activity/RemoveOldForks.pm b/lib/WebGUI/Workflow/Activity/RemoveOldForks.pm new file mode 100644 index 000000000..209d29341 --- /dev/null +++ b/lib/WebGUI/Workflow/Activity/RemoveOldForks.pm @@ -0,0 +1,82 @@ +package WebGUI::Workflow::Activity::RemoveOldForks; + +=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 warnings; +use strict; + +use base 'WebGUI::Workflow::Activity'; + +use WebGUI::International; +use WebGUI::Fork; + +=head1 NAME + +WebGUI::Workflow::Activity::RemoveOldForks + +=head1 DESCRIPTION + +Remove forks that are older than a configurable threshold. + +=head1 METHODS + +These methods are available from this class: + +=cut + +#------------------------------------------------------------------- + +=head2 definition ( session, definition ) + +See WebGUI::Workflow::Activity::definition() for details. + +=cut + +sub definition { + my ( $class, $session, $definition ) = @_; + my $i18n = WebGUI::International->new( $session, 'Workflow_Activity_RemoveOldForks' ); + my %def = ( + name => $i18n->get('activityName'), + properties => { + interval => { + fieldType => 'interval', + label => $i18n->get('interval'), + defaultValue => 60 * 60 * 24 * 7, + hoverHelp => $i18n->get('interval help') + } + } + ); + push @$definition, \%def; + return $class->SUPER::definition( $session, $definition ); +} ## end sub definition + +#------------------------------------------------------------------- + +=head2 execute ( [ object ] ) + +See WebGUI::Workflow::Activity::execute() for details. + +=cut + +sub execute { + my $self = shift; + my $db = $self->session->db; + my $tbl = $db->dbh->quote_identifier( WebGUI::Fork->tableName ); + my $time = time - $self->get('interval'); + $db->write( "DELETE FROM $tbl WHERE endTime <= ?", [$time] ); + return $self->COMPLETE; +} + +1; diff --git a/lib/WebGUI/i18n/English/Fork_ProgressBar.pm b/lib/WebGUI/i18n/English/Fork_ProgressBar.pm new file mode 100644 index 000000000..8556eb06e --- /dev/null +++ b/lib/WebGUI/i18n/English/Fork_ProgressBar.pm @@ -0,0 +1,22 @@ +package WebGUI::i18n::English::Fork_ProgressBar; + +use strict; + +our $I18N = { + 'time elapsed' => { + message => 'Time Elapsed', + lastUpdated => 1286466369, + context => 'Used as a label to indicate how many seconds have gone by since the forked process started running', + }, + 'seconds' => { + message => 'seconds', + lastUpdated => 1286466433, + }, + 'current asset' => { + message => 'Current Asset', + lastUpdated => 1286466701, + context => 'Used as a label to indicate which asset is in "focus"', + }, +}; + +1; diff --git a/lib/WebGUI/i18n/English/Workflow_Activity_RemoveOldForks.pm b/lib/WebGUI/i18n/English/Workflow_Activity_RemoveOldForks.pm new file mode 100644 index 000000000..c93ebe4d2 --- /dev/null +++ b/lib/WebGUI/i18n/English/Workflow_Activity_RemoveOldForks.pm @@ -0,0 +1,20 @@ +package WebGUI::i18n::English::Workflow_Activity_RemoveOldForks; + +use strict; + +our $I18N = { + 'interval help' => { + message => 'How long do we wait after process completion before deleting it?', + lastUpdated => 1285358250, + }, + 'interval' => { + message => q|Interval|, + lastUpdated => 1285358250, + }, + 'activityName' => { + message => q|Remove Old Forks|, + lastUpdated => 1285358250, + }, +}; + +1; diff --git a/sbin/preload.perl b/sbin/preload.perl index 4e54f6820..0adbef505 100644 --- a/sbin/preload.perl +++ b/sbin/preload.perl @@ -17,19 +17,6 @@ unshift @INC, grep { } } readLines($webguiRoot."/sbin/preload.custom"); -#---------------------------------------- -# Logger -#---------------------------------------- -require Log::Log4perl; -Log::Log4perl->init( $webguiRoot."/etc/log.conf" ); - -#---------------------------------------- -# Database connectivity. -#---------------------------------------- -#require Apache::DBI; # Uncomment if you want to enable connection pooling. Not recommended on servers with many sites, or those using db slaves. -require DBI; -DBI->install_driver("mysql"); # Change to match your database driver. - #---------------------------------------- # WebGUI modules. #---------------------------------------- @@ -48,6 +35,29 @@ WebGUI::Pluggable::findAndLoad( "WebGUI", } ); +#---------------------------------------- +# Preload all site configs. +#---------------------------------------- +WebGUI::Config->loadAllConfigs($webguiRoot); + +#---------------------------------------- +# WebGUI::Fork initialization +#---------------------------------------- +WebGUI::Fork->init(); + +#---------------------------------------- +# Logger +#---------------------------------------- +require Log::Log4perl; +Log::Log4perl->init( $webguiRoot."/etc/log.conf" ); + +#---------------------------------------- +# Database connectivity. +#---------------------------------------- +#require Apache::DBI; # Uncomment if you want to enable connection pooling. Not recommended on servers with many sites, or those using db slaves. +require DBI; +DBI->install_driver("mysql"); # Change to match your database driver. + require APR::Request::Apache2; require Apache2::Cookie; require Apache2::ServerUtil; @@ -64,12 +74,6 @@ $| = 1; print "\nStarting WebGUI ".$WebGUI::VERSION."\n"; -#---------------------------------------- -# Preload all site configs. -#---------------------------------------- -WebGUI::Config->loadAllConfigs($webguiRoot); - - # reads lines from a file into an array, trimming white space and ignoring commented lines sub readLines { my $file = shift; diff --git a/t/Asset/AssetClipboard.t b/t/Asset/AssetClipboard.t index 8eb2bbb1c..526425e50 100644 --- a/t/Asset/AssetClipboard.t +++ b/t/Asset/AssetClipboard.t @@ -20,6 +20,7 @@ use WebGUI::Session; use WebGUI::Utility; use WebGUI::Asset; use WebGUI::VersionTag; +use Test::MockObject; use Test::More; # increment this value for each test you create plan tests => 29; @@ -148,12 +149,20 @@ sub copied { return undef; } -my @methods = qw(Single Children Descendants); +my $process = Test::MockObject->new->mock(update => sub {}); +my @methods = ( + # single duplicate doesn't fork, so we can just test the www method to + # make sure it gets it right + sub { shift->www_copy }, + sub { shift->duplicateBranch(1, 'clipboard') }, + sub { shift->duplicateBranch(0, 'clipboard') }, +); +my @prefixes = qw(single children descendants); for my $i (0..2) { - my $meth = "_wwwCopy$methods[$i]"; + my $meth = $methods[$i]; $root->$meth(); my $clip = copied(); - is_tree_of_folders($clip, $i+1, $meth); + is_tree_of_folders($clip, $i+1, @prefixes[$i]); $clip->purge; } diff --git a/t/Fork.t b/t/Fork.t new file mode 100644 index 000000000..8e9d51909 --- /dev/null +++ b/t/Fork.t @@ -0,0 +1,106 @@ +# 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 +#------------------------------------------------------------------ + +# WebGUI::Fork tests + +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin/lib"; +use lib "$FindBin::Bin/../lib"; + +use Test::More; +use Test::Deep; +use Data::Dumper; +use JSON; + +use WebGUI::Test; +use WebGUI::Session; +use WebGUI::Fork; + +my $class = 'WebGUI::Fork'; +my $testClass = 'WebGUI::Test::Fork'; +my $pipe = $class->init(); +my $session = WebGUI::Test->session; + +# test simplest (non-forking) case + +my $process = $class->create($session); +my $request = $process->request( $testClass, 'simple', ['data'] ); + +cmp_bag( + [ keys %$request ], + [qw(webguiRoot configFile sessionId id module subname data)], + 'request hash has the right keys' +); + +my $now = time; + +$class->runRequest($request); +ok $process->isFinished, 'finished'; +my $error = $process->getError; +ok( !$error, 'no errors' ) or diag " Expected nothing, got: $error\n"; +$process->setWait(0); +is $process->getStatus, 'data', 'proper status'; +my $started = $process->startTime; +ok( ( $started >= $now ), 'sane startTime' ); +ok( ( $process->endTime >= $started ), 'sane endTime' ); + +$process->delete; + +note "Testing error case\n"; +$process = $class->create($session); +$request = $process->request( $testClass, 'error', ['error'] ); +$class->runRequest($request); +ok $process->isFinished, 'finished'; +is $process->getError, "error\n", 'has error code'; +$process->setWait(0); +my $status = $process->getStatus; +ok( !$status, 'no discernable status' ) or diag $status; +ok( ( $process->endTime >= $started ), 'sane endTime' ); + +my $forkCount = 0; +my $forkAndExec = $class->can('forkAndExec'); +my $replace = sub { + my $self = shift; + $forkCount++; + $self->$forkAndExec(@_); +}; + +{ + no strict 'refs'; + no warnings 'redefine'; + *{ $class . '::forkAndExec' } = $replace; +} + +sub backgroundTest { + note "$_[0]\n"; + $process = $class->start( $session, $testClass, 'complex', ['data'] ); + my $sleeping; + while ( !$process->isFinished && $sleeping++ < 10 ) { + sleep 1; + } + ok $process->isFinished, 'finished'; + is $process->getStatus, 'baz', 'correct status' + or diag $process->getError . "\n"; + + $process->delete; +} +backgroundTest('talk to background'); +is $forkCount, 0, 'we did not fork'; +close $pipe; +backgroundTest('On-demand fork'); +is $forkCount, 1, 'we did fork'; + +done_testing; + +#vim:ft=perl diff --git a/t/lib/WebGUI/Test/Fork.pm b/t/lib/WebGUI/Test/Fork.pm new file mode 100644 index 000000000..ff86fbfed --- /dev/null +++ b/t/lib/WebGUI/Test/Fork.pm @@ -0,0 +1,20 @@ +package WebGUI::Test::Fork; + +sub simple { + my ( $self, $arr ) = @_; + $self->update( $arr->[0] ); +} + +sub error { + my ( $self, $arr ) = @_; + die "$arr->[0]\n"; +} + +sub complex { + my $self = shift; + $self->update( sub {'foo'} ); + $self->update( sub {'bar'} ); + $self->update( sub {'baz'} ); +} + +1; diff --git a/www/extras/Fork/ProgressBar.css b/www/extras/Fork/ProgressBar.css new file mode 100644 index 000000000..d00e142b6 --- /dev/null +++ b/www/extras/Fork/ProgressBar.css @@ -0,0 +1,20 @@ +.webgui-fork-pb { + border: thin solid black; + position: relative; + line-height: 20pt; + height: 20pt; +} + +.webgui-fork-pb .webgui-fork-pb-bar { + background-color: lime; + height: 100%; +} + +.webgui-fork-pb .webgui-fork-pb-caption { + position: absolute; + top: 0; + left: 0; + width: 100%; + text-align: center; + font-size: 18pt; +} diff --git a/www/extras/Fork/ProgressBar.js b/www/extras/Fork/ProgressBar.js new file mode 100644 index 000000000..3b6647950 --- /dev/null +++ b/www/extras/Fork/ProgressBar.js @@ -0,0 +1,30 @@ +/*global YAHOO, WebGUI, document */ +/* Dependencies: yahoo, dom */ +(function () { + var dom = YAHOO.util.Dom, + ns = YAHOO.namespace('WebGUI.Fork'), + cls = ns.ProgressBar = function () {}, + proto = cls.prototype; + + proto.render = function (node) { + var bar, cap; + if (!node.tagName) { + node = document.getElementById(node); + } + dom.addClass(node, 'webgui-fork-pb'); + bar = document.createElement('div'); + cap = document.createElement('div'); + dom.addClass(bar, 'webgui-fork-pb-bar'); + dom.addClass(cap, 'webgui-fork-pb-caption'); + node.appendChild(bar); + node.appendChild(cap); + this.domNode = node; + this.bar = bar; + this.caption = cap; + }; + proto.update = function (done, total) { + var pct = (total > 0 ? Math.floor((done/total)*100) : 100) + '%'; + this.caption.innerHTML = pct; + this.bar.style.width = pct; + }; +}()); diff --git a/www/extras/Fork/poll.js b/www/extras/Fork/poll.js new file mode 100644 index 000000000..5bb1a7761 --- /dev/null +++ b/www/extras/Fork/poll.js @@ -0,0 +1,42 @@ +/*global YAHOO, setTimeout */ +/* Dependencies: yahoo, connection_core, json */ + +(function () { + var ns = YAHOO.namespace('WebGUI.Fork'), JSON = YAHOO.lang.JSON; + + ns.poll = function(args) { + function fetch() { + var first = true; + YAHOO.util.Connect.asyncRequest('GET', args.url, { + success: function (o) { + var data, e; + if (o.status != 200) { + args.error("Server returned bad response"); + return; + } + data = JSON.parse(o.responseText); + e = data.error; + if (e) { + args.error(e); + return; + } + args.draw(data); + if (args.first && first) { + first = false; + args.first(); + } + if (data.finished) { + args.finish(); + } + else { + setTimeout(fetch, args.interval || 1000); + } + }, + failure: function (o) { + args.error("Could not communicate with server"); + } + }); + } + fetch(); + }; +}()); diff --git a/www/extras/Fork/redirect.js b/www/extras/Fork/redirect.js new file mode 100644 index 000000000..bf4c061e3 --- /dev/null +++ b/www/extras/Fork/redirect.js @@ -0,0 +1,16 @@ +/*global YAHOO, setTimeout, window */ +/* Dependencies: yahoo */ + +(function () { + var ns = YAHOO.namespace('WebGUI.Fork'); + ns.redirect = function (redir, after) { + if (!redir) { + return; + } + setTimeout(function() { + // The idea here is to only allow local redirects + var loc = window.location; + loc.href = loc.protocol + '//' + loc.host + redir; + }, after || 1000); + }; +}());