Merge branch 'fork'
This commit is contained in:
Paul Driver
commit
7219e21f86
28 changed files with 2399 additions and 251 deletions
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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 --------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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<br />";
|
||||
},
|
||||
'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<br />");
|
||||
}
|
||||
$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 = '<iframe src="' . $iframeUrl . '" title="' . $i18n->get('Page Export Status') . '" width="100%" height="500"></iframe>';
|
||||
$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
|
||||
}
|
||||
}
|
||||
);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -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<proceeed>.
|
|||
=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));
|
||||
);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
|
|
|||
668
lib/WebGUI/Fork.pm
Normal file
668
lib/WebGUI/Fork.pm
Normal file
|
|
@ -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 $/; <STDIN> };
|
||||
$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;
|
||||
140
lib/WebGUI/Fork/ProgressBar.pm
Normal file
140
lib/WebGUI/Fork/ProgressBar.pm
Normal file
|
|
@ -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';
|
||||
<div id='loading'>[% i18n('WebGUI', 'Loading...') %]</div>
|
||||
<div id='ui' style='display: none'>
|
||||
<p id='message'></p>
|
||||
<div id='meter'></div>
|
||||
<p>
|
||||
[% i18n('Fork_ProgressBar', 'time elapsed') %]:
|
||||
<span id='elapsed'></span> [% i18n('Fork_ProgressBar', 'seconds') %].
|
||||
</p>
|
||||
</div>
|
||||
<script>
|
||||
(function (params) {
|
||||
var bar = new YAHOO.WebGUI.Fork.ProgressBar();
|
||||
YAHOO.util.Event.onDOMReady(function () {
|
||||
bar.render('meter');
|
||||
YAHOO.WebGUI.Fork.poll({
|
||||
url : params.statusUrl,
|
||||
draw : function (data) {
|
||||
var status = YAHOO.lang.JSON.parse(data.status);
|
||||
bar.update(status.finished, status.total);
|
||||
document.getElementById('message').innerHTML = status.message;
|
||||
document.getElementById('elapsed').innerHTML = data.elapsed;
|
||||
},
|
||||
first : function () {
|
||||
document.getElementById('loading').style.display = 'none';
|
||||
document.getElementById('ui').style.display = 'block';
|
||||
},
|
||||
finish : function() {
|
||||
YAHOO.WebGUI.Fork.redirect(params.redirect);
|
||||
},
|
||||
error : function (msg) {
|
||||
alert(msg);
|
||||
}
|
||||
});
|
||||
});
|
||||
}([% params %]));
|
||||
</script>
|
||||
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;
|
||||
155
lib/WebGUI/Fork/ProgressTree.pm
Normal file
155
lib/WebGUI/Fork/ProgressTree.pm
Normal file
|
|
@ -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';
|
||||
<div id='loading'>[% i18n('WebGUI', 'Loading...') %]</div>
|
||||
<div id='ui' style='display: none'>
|
||||
<div id='meter'></div>
|
||||
[% i18n('Fork_ProgressBar', 'current asset') %]: <span id='focus'></span>
|
||||
(<span id='finished'></span>/<span id='total'></span>).<br />
|
||||
[% i18n('Fork_ProgressBar', 'time elapsed') %]:
|
||||
<span id='elapsed'></span>
|
||||
[% i18n('Fork_ProgressBar', 'seconds') %].
|
||||
<ul id='tree'></ul>
|
||||
</div>
|
||||
<script>
|
||||
(function (params) {
|
||||
var bar = new YAHOO.WebGUI.Fork.ProgressBar();
|
||||
|
||||
function setHtml(id, html) {
|
||||
document.getElementById(id).innerHTML = html;
|
||||
}
|
||||
function draw(data) {
|
||||
var tree, finished = 0, total = 0, focus, pct;
|
||||
function recurse(asset, node) {
|
||||
var li = document.createElement('li'), txt, notes, ul, i;
|
||||
|
||||
total += 1;
|
||||
|
||||
txt = asset.url;
|
||||
if (asset.success) {
|
||||
li.className = 'success';
|
||||
finished += 1;
|
||||
}
|
||||
else if (asset.failure) {
|
||||
li.className = 'failure';
|
||||
txt += ' (' + asset.failure + ')';
|
||||
finished += 1;
|
||||
}
|
||||
if (asset.focus) {
|
||||
li.className += 'focus';
|
||||
focus = asset.url;
|
||||
}
|
||||
li.appendChild(document.createTextNode(txt));
|
||||
if (notes = asset.notes) {
|
||||
_.each(notes, function (note) {
|
||||
var p = document.createElement('p');
|
||||
p.innerHTML = note;
|
||||
li.appendChild(p);
|
||||
});
|
||||
}
|
||||
if (asset.children) {
|
||||
ul = document.createElement('ul');
|
||||
_.each(asset.children, function (child) {
|
||||
recurse(child, ul);
|
||||
});
|
||||
li.appendChild(ul);
|
||||
}
|
||||
node.appendChild(li);
|
||||
}
|
||||
tree = document.getElementById('tree');
|
||||
tree.innerHTML = '';
|
||||
_.each(JSON.parse(data.status), function (root) {
|
||||
recurse(root, tree);
|
||||
});
|
||||
bar.update(finished, total);
|
||||
setHtml('total', total);
|
||||
setHtml('finished', finished);
|
||||
setHtml('focus', focus || 'nothing');
|
||||
setHtml('elapsed', data.elapsed);
|
||||
}
|
||||
YAHOO.util.Event.onDOMReady(function () {
|
||||
bar.render('meter');
|
||||
YAHOO.WebGUI.Fork.poll({
|
||||
url : params.statusUrl,
|
||||
draw : draw,
|
||||
first : function () {
|
||||
document.getElementById('loading').style.display = 'none';
|
||||
document.getElementById('ui').style.display = 'block';
|
||||
},
|
||||
finish : function () {
|
||||
YAHOO.WebGUI.Fork.redirect(params.redirect);
|
||||
},
|
||||
error : function (msg) {
|
||||
alert(msg)
|
||||
}
|
||||
});
|
||||
});
|
||||
}([% params %]));
|
||||
</script>
|
||||
TEMPLATE
|
||||
|
||||
my $stylesheet = <<'STYLESHEET';
|
||||
<style>
|
||||
#tree li { color: black }
|
||||
#tree li.focus { color: cyan }
|
||||
#tree li.failure { color: red }
|
||||
#tree li.success { color: green }
|
||||
</style>
|
||||
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;
|
||||
84
lib/WebGUI/Fork/Status.pm
Normal file
84
lib/WebGUI/Fork/Status.pm
Normal file
|
|
@ -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;
|
||||
|
|
@ -76,6 +76,7 @@ Returns a hash reference containing operation and package names.
|
|||
|
||||
sub getOperations {
|
||||
return {
|
||||
'fork' => 'Fork',
|
||||
'killSession' => 'ActiveSessions',
|
||||
'viewActiveSessions' => 'ActiveSessions',
|
||||
|
||||
|
|
|
|||
74
lib/WebGUI/Operation/Fork.pm
Normal file
74
lib/WebGUI/Operation/Fork.pm
Normal file
|
|
@ -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;
|
||||
|
|
@ -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';
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
172
lib/WebGUI/ProgressTree.pm
Normal file
172
lib/WebGUI/ProgressTree.pm
Normal file
|
|
@ -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;
|
||||
|
|
@ -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.
|
||||
|
|
|
|||
82
lib/WebGUI/Workflow/Activity/RemoveOldForks.pm
Normal file
82
lib/WebGUI/Workflow/Activity/RemoveOldForks.pm
Normal file
|
|
@ -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;
|
||||
22
lib/WebGUI/i18n/English/Fork_ProgressBar.pm
Normal file
22
lib/WebGUI/i18n/English/Fork_ProgressBar.pm
Normal file
|
|
@ -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;
|
||||
20
lib/WebGUI/i18n/English/Workflow_Activity_RemoveOldForks.pm
Normal file
20
lib/WebGUI/i18n/English/Workflow_Activity_RemoveOldForks.pm
Normal file
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
|||
106
t/Fork.t
Normal file
106
t/Fork.t
Normal file
|
|
@ -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
|
||||
20
t/lib/WebGUI/Test/Fork.pm
Normal file
20
t/lib/WebGUI/Test/Fork.pm
Normal file
|
|
@ -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;
|
||||
20
www/extras/Fork/ProgressBar.css
Normal file
20
www/extras/Fork/ProgressBar.css
Normal file
|
|
@ -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;
|
||||
}
|
||||
30
www/extras/Fork/ProgressBar.js
Normal file
30
www/extras/Fork/ProgressBar.js
Normal file
|
|
@ -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;
|
||||
};
|
||||
}());
|
||||
42
www/extras/Fork/poll.js
Normal file
42
www/extras/Fork/poll.js
Normal file
|
|
@ -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();
|
||||
};
|
||||
}());
|
||||
16
www/extras/Fork/redirect.js
Normal file
16
www/extras/Fork/redirect.js
Normal file
|
|
@ -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);
|
||||
};
|
||||
}());
|
||||
Loading…
Add table
Add a link
Reference in a new issue