adding FilePump
This commit is contained in:
Colin Kuskie
commit
d8a1623ea0
14 changed files with 1986 additions and 1 deletions
|
|
@ -10,6 +10,8 @@
|
||||||
- added Google Maps asset
|
- added Google Maps asset
|
||||||
- added a way for authors to prevent debugging output on page requests
|
- added a way for authors to prevent debugging output on page requests
|
||||||
- added --noprompt option to testEnvironment.pl to automatically install modules
|
- added --noprompt option to testEnvironment.pl to automatically install modules
|
||||||
|
- added FilePump, a way to reduce Yslow scores by minimizing JS, CSS and the
|
||||||
|
number of files transferred.
|
||||||
|
|
||||||
7.7.6
|
7.7.6
|
||||||
- Added mobile style template. If enabled in settings, will serve alternate style templates
|
- Added mobile style template. If enabled in settings, will serve alternate style templates
|
||||||
|
|
|
||||||
|
|
@ -22,7 +22,7 @@ use Getopt::Long;
|
||||||
use WebGUI::Session;
|
use WebGUI::Session;
|
||||||
use WebGUI::Storage;
|
use WebGUI::Storage;
|
||||||
use WebGUI::Asset;
|
use WebGUI::Asset;
|
||||||
|
use WebGUI::FilePump::Bundle;
|
||||||
|
|
||||||
my $toVersion = '7.7.7';
|
my $toVersion = '7.7.7';
|
||||||
my $quiet; # this line required
|
my $quiet; # this line required
|
||||||
|
|
@ -36,6 +36,9 @@ addRedirectAfterLoginUrlToSettings( $session );
|
||||||
addSurveyTestResultsTemplateColumn( $session );
|
addSurveyTestResultsTemplateColumn( $session );
|
||||||
fixSMSUserProfileI18N($session);
|
fixSMSUserProfileI18N($session);
|
||||||
addMapAsset( $session );
|
addMapAsset( $session );
|
||||||
|
installFilePumpHandler($session);
|
||||||
|
installFilePumpTable($session);
|
||||||
|
installFilePumpAdminGroup($session);
|
||||||
|
|
||||||
finish($session); # this line required
|
finish($session); # this line required
|
||||||
|
|
||||||
|
|
@ -107,6 +110,48 @@ sub addSurveyTestResultsTemplateColumn {
|
||||||
print "Done\n" unless $quiet;
|
print "Done\n" unless $quiet;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#----------------------------------------------------------------------------
|
||||||
|
sub installFilePumpAdminGroup {
|
||||||
|
my $session = shift;
|
||||||
|
print "\tAdding FilePump admin group setting... \n" unless $quiet;
|
||||||
|
##Content Handler
|
||||||
|
#if (! $session->setting->has('groupIdAdminFilePump')) {
|
||||||
|
$session->setting->add('groupIdAdminFilePump','8');
|
||||||
|
print "\tAdded FilePump admin group ... \n" unless $quiet;
|
||||||
|
#}
|
||||||
|
print "Done.\n" unless $quiet;
|
||||||
|
}
|
||||||
|
|
||||||
|
#----------------------------------------------------------------------------
|
||||||
|
sub installFilePumpHandler {
|
||||||
|
my $session = shift;
|
||||||
|
print "\tAdding FilePump content handler... \n" unless $quiet;
|
||||||
|
##Content Handler
|
||||||
|
my $contentHandlers = $session->config->get('contentHandlers');
|
||||||
|
$session->config->addToArray('contentHandlers', 'WebGUI::Content::FilePump');
|
||||||
|
$session->config->addToHash( 'macros', { FilePump => 'FilePump' });
|
||||||
|
|
||||||
|
##Admin Console
|
||||||
|
$session->config->addToHash('adminConsole', 'filePump', {
|
||||||
|
"icon" => "filePump.png",
|
||||||
|
"groupSetting" => "groupIdAdminFilePump",
|
||||||
|
"uiLevel" => 5,
|
||||||
|
"url" => "^PageUrl(\"\",op=filePump);",
|
||||||
|
"title" => "^International(File Pump,FilePump);"
|
||||||
|
});
|
||||||
|
##Setting for custom group
|
||||||
|
print "Done.\n" unless $quiet;
|
||||||
|
}
|
||||||
|
|
||||||
|
#----------------------------------------------------------------------------
|
||||||
|
sub installFilePumpTable {
|
||||||
|
my $session = shift;
|
||||||
|
print "\tAdding FilePump database table via CRUD... \n" unless $quiet;
|
||||||
|
WebGUI::FilePump::Bundle->crud_createTable($session);
|
||||||
|
print "Done.\n" unless $quiet;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
#----------------------------------------------------------------------------
|
#----------------------------------------------------------------------------
|
||||||
# Add the map asset
|
# Add the map asset
|
||||||
sub addMapAsset {
|
sub addMapAsset {
|
||||||
|
|
|
||||||
|
|
@ -402,6 +402,13 @@
|
||||||
"url" : "^PageUrl(\"\",op=manageCache);",
|
"url" : "^PageUrl(\"\",op=manageCache);",
|
||||||
"title" : "^International(manage cache,WebGUI);",
|
"title" : "^International(manage cache,WebGUI);",
|
||||||
"groupSetting" : "groupIdAdminCache"
|
"groupSetting" : "groupIdAdminCache"
|
||||||
|
},
|
||||||
|
"filePump" : {
|
||||||
|
"icon" : "filePump.png",
|
||||||
|
"uiLevel" : 5,
|
||||||
|
"url" : "^PageUrl(\"\",op=filePump);",
|
||||||
|
"title" : "^International(File Pump,FilePump);",
|
||||||
|
"groupSetting" : "groupIdAdminFilePump"
|
||||||
}
|
}
|
||||||
},
|
},
|
||||||
|
|
||||||
|
|
@ -778,6 +785,7 @@
|
||||||
"e" : "e_companyEmail",
|
"e" : "e_companyEmail",
|
||||||
"Extras" : "Extras",
|
"Extras" : "Extras",
|
||||||
"FetchMimeType" : "FetchMimeType",
|
"FetchMimeType" : "FetchMimeType",
|
||||||
|
"FilePump" : "FilePump",
|
||||||
"FileUrl" : "FileUrl",
|
"FileUrl" : "FileUrl",
|
||||||
"GroupAdd" : "GroupAdd",
|
"GroupAdd" : "GroupAdd",
|
||||||
"GroupDelete" : "GroupDelete",
|
"GroupDelete" : "GroupDelete",
|
||||||
|
|
|
||||||
52
lib/WebGUI/Content/FilePump.pm
Normal file
52
lib/WebGUI/Content/FilePump.pm
Normal file
|
|
@ -0,0 +1,52 @@
|
||||||
|
package WebGUI::Content::FilePump;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use WebGUI::AdminConsole;
|
||||||
|
use WebGUI::Exception;
|
||||||
|
use WebGUI::FilePump::Admin;
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
Package WebGUI::Content::FilePump
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
Handle all requests for building and editing FilePump bundles
|
||||||
|
|
||||||
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
|
use WebGUI::Content::FilePump;
|
||||||
|
my $output = WebGUI::Content::FilePump::handler($session);
|
||||||
|
|
||||||
|
=head1 SUBROUTINES
|
||||||
|
|
||||||
|
These subroutines are available from this package:
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 handler ( session )
|
||||||
|
|
||||||
|
The content handler for this package.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub handler {
|
||||||
|
my ($session) = @_;
|
||||||
|
my $output = undef;
|
||||||
|
return undef unless $session->form->get('op') eq 'filePump';
|
||||||
|
my $func = $session->form->get( 'func' )
|
||||||
|
? 'www_' . $session->form->get( 'func' )
|
||||||
|
: 'www_manage'
|
||||||
|
;
|
||||||
|
if ($func ne "www_" && (my $sub = WebGUI::FilePump::Admin->can($func))) {
|
||||||
|
$output = $sub->($session);
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
WebGUI::Error::MethodNotFound->throw(error=>"Couldn't call non-existant function $func inside FilePump", method=>$func);
|
||||||
|
}
|
||||||
|
return $output;
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
371
lib/WebGUI/FilePump/Admin.pm
Normal file
371
lib/WebGUI/FilePump/Admin.pm
Normal file
|
|
@ -0,0 +1,371 @@
|
||||||
|
package WebGUI::FilePump::Admin;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use Tie::IxHash;
|
||||||
|
use WebGUI::AdminConsole;
|
||||||
|
use WebGUI::HTMLForm;
|
||||||
|
use WebGUI::International;
|
||||||
|
use WebGUI::Pluggable;
|
||||||
|
use WebGUI::Utility;
|
||||||
|
use WebGUI::FilePump::Bundle;
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
Package WebGUI::FilePump::Admin
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
Web interface for making, building, and editing FilePump bundles.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
#----------------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 canView ( session [, user] )
|
||||||
|
|
||||||
|
Returns true if the user can administrate this operation. user defaults to
|
||||||
|
the current user.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub canView {
|
||||||
|
my $session = shift;
|
||||||
|
my $user = shift || $session->user;
|
||||||
|
return $user->isInGroup( $session->setting->get('groupIdAdminFilePump') );
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 www_addBundle ( )
|
||||||
|
|
||||||
|
Displays a form to add a bundle.
|
||||||
|
|
||||||
|
Note, we do not allow bundle names to be edited. This is why. The directory to a bundle is based on
|
||||||
|
the bundle name, and the time stamp of the last build. If you change the name, then you have a few
|
||||||
|
options.
|
||||||
|
|
||||||
|
1) You delete the build directory with the old name, which will break every macro which references it.
|
||||||
|
|
||||||
|
2) You leave it there, which means that they accumulate with time since they can't every be deleted because
|
||||||
|
you don't know the old name.
|
||||||
|
|
||||||
|
In short, this really means that instead of an option to edit the name, it needs a copy function. When you
|
||||||
|
copy the bundle, it asks you what you want for a new name, and it is supplied by the user at that time.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub www_addBundle {
|
||||||
|
my ($session) = @_;
|
||||||
|
return $session->privilege->insufficient() unless canView($session);
|
||||||
|
|
||||||
|
##Build the form
|
||||||
|
my $i18n = WebGUI::International->new($session, 'FilePump');
|
||||||
|
my $form = WebGUI::HTMLForm->new($session);
|
||||||
|
$form->hidden( name=>"op", value=>"filePump");
|
||||||
|
$form->hidden( name=>"func", value=>"addBundleSave");
|
||||||
|
$form->text(
|
||||||
|
name => 'bundleName',
|
||||||
|
defaultValue => $i18n->get('new bundle'),
|
||||||
|
label => $i18n->get('bundle name'),
|
||||||
|
hoverHelp => $i18n->get('bundle name help'),
|
||||||
|
);
|
||||||
|
$form->submit;
|
||||||
|
|
||||||
|
my $ac = WebGUI::AdminConsole->new($session,'filePump');
|
||||||
|
return $ac->render($form->print, $i18n->get('Add Bundle'));
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 www_addBundleSave ( )
|
||||||
|
|
||||||
|
Saves the results of www_addBundle().
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub www_addBundleSave {
|
||||||
|
my $session = shift;
|
||||||
|
return $session->privilege->insufficient() unless canView($session);
|
||||||
|
my $form = $session->form;
|
||||||
|
my $bundleName = $form->get('bundleName');
|
||||||
|
my $bundle = WebGUI::FilePump::Bundle->create($session, {
|
||||||
|
bundleName => $bundleName,
|
||||||
|
lastModified => time(),
|
||||||
|
});
|
||||||
|
return www_manage($session);
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 www_addFile ( )
|
||||||
|
|
||||||
|
Processes the form to add a file to a bundle.
|
||||||
|
|
||||||
|
Form variables used:
|
||||||
|
|
||||||
|
=item uri
|
||||||
|
|
||||||
|
The URI to add.
|
||||||
|
|
||||||
|
=item type
|
||||||
|
|
||||||
|
The type of file to add.
|
||||||
|
|
||||||
|
=item bundleId
|
||||||
|
|
||||||
|
The GUID of the bundle to add a file to.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub www_addFile {
|
||||||
|
my ($session) = @_;
|
||||||
|
return $session->privilege->insufficient() unless canView($session);
|
||||||
|
my $form = $session->form;
|
||||||
|
my $bundleId = $form->get('bundleId');
|
||||||
|
my $bundle = WebGUI::FilePump::Bundle->new($session, $bundleId);
|
||||||
|
return www_editBundle($session) unless $bundle;
|
||||||
|
|
||||||
|
my $type = $form->get('type');
|
||||||
|
my $uri = $form->get('uri');
|
||||||
|
|
||||||
|
my (undef, $error) = $bundle->addFile($type, $uri);
|
||||||
|
|
||||||
|
return www_editBundle($session, $error);
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 www_buildBundle ( )
|
||||||
|
|
||||||
|
Builds a bundle, identified by the form variable, bundleId.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub www_buildBundle {
|
||||||
|
my $session = shift;
|
||||||
|
return $session->privilege->insufficient() unless canView($session);
|
||||||
|
my $bundle = WebGUI::FilePump::Bundle->new($session, $session->form->get("bundleId"));
|
||||||
|
return www_editBundle($session) unless $bundle;
|
||||||
|
my ($code, $error) = $bundle->build;
|
||||||
|
if ($error) {
|
||||||
|
my $i18n = WebGUI::International->new($session, 'FilePump');
|
||||||
|
$error = sprintf $i18n->get('build error'), $error;
|
||||||
|
}
|
||||||
|
return www_editBundle($session, $error);
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 www_deleteBundle ( )
|
||||||
|
|
||||||
|
Deletes a bundle, identified by the form variable, bundleId.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub www_deleteBundle {
|
||||||
|
my $session = shift;
|
||||||
|
return $session->privilege->insufficient() unless canView($session);
|
||||||
|
my $bundle = WebGUI::FilePump::Bundle->new($session, $session->form->get("bundleId"));
|
||||||
|
if (defined $bundle) {
|
||||||
|
$bundle->delete;
|
||||||
|
}
|
||||||
|
return www_manage($session);
|
||||||
|
}
|
||||||
|
|
||||||
|
#------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 www_deleteFile ( session )
|
||||||
|
|
||||||
|
Deletes a file from it's bundle. The kind of file is set by the form variable filetype,
|
||||||
|
the id of the bundle is bundleId, and the id of the file to move is fileId.
|
||||||
|
|
||||||
|
=head3 session
|
||||||
|
|
||||||
|
A reference to the current session.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub www_deleteFile {
|
||||||
|
my $session = shift;
|
||||||
|
return $session->privilege->insufficient() unless canView($session);
|
||||||
|
my $form = $session->form;
|
||||||
|
my $bundle = WebGUI::FilePump::Bundle->new($session, $form->get("bundleId"));
|
||||||
|
return www_editBundle($session) unless $bundle;
|
||||||
|
$bundle->deleteFile($form->get('fileType'), $form->get('fileId'));
|
||||||
|
return www_editBundle($session);
|
||||||
|
}
|
||||||
|
|
||||||
|
#------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 www_demoteFile ( session )
|
||||||
|
|
||||||
|
Moves a bundle file down one position. The kind of file is set by the form variable fileType,
|
||||||
|
the id of the bundle is bundleId, and the id of the file to move is fileId.
|
||||||
|
|
||||||
|
=head3 session
|
||||||
|
|
||||||
|
A reference to the current session.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub www_demoteFile {
|
||||||
|
my $session = shift;
|
||||||
|
return $session->privilege->insufficient() unless canView($session);
|
||||||
|
my $form = $session->form;
|
||||||
|
my $bundle = WebGUI::FilePump::Bundle->new($session, $form->get("bundleId"));
|
||||||
|
return www_editBundle($session) unless $bundle;
|
||||||
|
my $type = $form->get('fileType');
|
||||||
|
my $fileId = $form->get('fileId');
|
||||||
|
$bundle->moveFileDown($type, $fileId);
|
||||||
|
return www_editBundle($session);
|
||||||
|
}
|
||||||
|
|
||||||
|
#------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 www_editBundle ( session )
|
||||||
|
|
||||||
|
Interface for managing URIs in a bundle, given by the form param bundleId. Add, delete,
|
||||||
|
promote and demote are supported for all three file types.
|
||||||
|
|
||||||
|
=head3 session
|
||||||
|
|
||||||
|
A reference to the current session.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub www_editBundle {
|
||||||
|
my ($session, $error) = @_;
|
||||||
|
return $session->privilege->insufficient() unless canView($session);
|
||||||
|
my $bundleId = $session->form->get("bundleId");
|
||||||
|
my $bundle = WebGUI::FilePump::Bundle->new($session, $bundleId);
|
||||||
|
return www_addBundle($session) unless $bundle;
|
||||||
|
my $i18n = WebGUI::International->new($session, 'FilePump');
|
||||||
|
if ($error) {
|
||||||
|
$error = qq|<div class="error">$error</div>\n|;
|
||||||
|
}
|
||||||
|
my $tableStub = <<EOTABLE;
|
||||||
|
<h2>%s</h2>
|
||||||
|
<table border=1>
|
||||||
|
<tr><th> </th><th>URI</th><th>%s</th></tr>
|
||||||
|
%s
|
||||||
|
</table>
|
||||||
|
<p>%s</p>
|
||||||
|
EOTABLE
|
||||||
|
my $output = '';
|
||||||
|
my $dt = $session->datetime;
|
||||||
|
my $url = $session->url;
|
||||||
|
my $lastModifiedi18n = $i18n->get('last modified');
|
||||||
|
foreach my $fileType (qw/jsFiles cssFiles/) {
|
||||||
|
my $type = $fileType eq 'jsFiles' ? 'JS'
|
||||||
|
: $fileType eq 'cssFiles' ? 'CSS'
|
||||||
|
: 'OTHER';
|
||||||
|
my $form = WebGUI::Form::formHeader($session, {
|
||||||
|
action => $url->gateway($url->getRequestedUrl,'op=filePump;func=addFile;type='.$type.';bundleId='.$bundleId),
|
||||||
|
})
|
||||||
|
. WebGUI::Form::text($session, {
|
||||||
|
name => 'uri',
|
||||||
|
size => 45,
|
||||||
|
})
|
||||||
|
. WebGUI::Form::submit($session)
|
||||||
|
. WebGUI::Form::formFooter()
|
||||||
|
;
|
||||||
|
|
||||||
|
my $rows = '';
|
||||||
|
my $files = $bundle->get($fileType);
|
||||||
|
foreach my $file (@{ $files }) {
|
||||||
|
my $urlFrag = 'bundleId='.$bundleId.';fileType='.$type.';fileId='.$file->{fileId};
|
||||||
|
$rows .= sprintf '<tr><td>%s</td><td>%s</td><td>%s</td></tr>',
|
||||||
|
$session->icon->delete( 'op=filePump;func=deleteFile;' . $urlFrag).
|
||||||
|
$session->icon->moveUp( 'op=filePump;func=promoteFile;' . $urlFrag).
|
||||||
|
$session->icon->moveDown( 'op=filePump;func=demoteFile;' . $urlFrag) ,
|
||||||
|
$file->{uri},
|
||||||
|
$file->{lastModified} ? $dt->epochToHuman($file->{lastModified}) : ' '
|
||||||
|
;
|
||||||
|
}
|
||||||
|
$output .= sprintf $tableStub, $i18n->get($fileType), $lastModifiedi18n, $rows, $form;
|
||||||
|
}
|
||||||
|
|
||||||
|
my $ac = WebGUI::AdminConsole->new($session,'filePump');
|
||||||
|
$ac->addSubmenuItem($session->url->page('op=filePump;'), $i18n->get('list bundles'));
|
||||||
|
$ac->addSubmenuItem($session->url->page('op=filePump;func=addBundle'), $i18n->get('add a bundle'));
|
||||||
|
$ac->addSubmenuItem($session->url->page('op=filePump;func=buildBundle;bundleId='.$bundleId), $i18n->get('build this bundle'));
|
||||||
|
return $ac->render($error.$output, 'File Pump');
|
||||||
|
}
|
||||||
|
|
||||||
|
#------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 www_promoteFile ( session )
|
||||||
|
|
||||||
|
Moves a bundle file up one position. The kind of file is set by the form variable fileType,
|
||||||
|
the id of the bundle is bundleId, and the id of the file to move is fileId.
|
||||||
|
|
||||||
|
=head3 session
|
||||||
|
|
||||||
|
A reference to the current session.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub www_promoteFile {
|
||||||
|
my $session = shift;
|
||||||
|
return $session->privilege->insufficient() unless canView($session);
|
||||||
|
my $form = $session->form;
|
||||||
|
my $bundle = WebGUI::FilePump::Bundle->new($session, $session->form->get("bundleId"));
|
||||||
|
return www_editBundle($session) unless $bundle;
|
||||||
|
my $type = $form->get('fileType');
|
||||||
|
my $fileId = $form->get('fileId');
|
||||||
|
$bundle->moveFileUp($type, $fileId);
|
||||||
|
return www_editBundle($session);
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 www_manage ( session )
|
||||||
|
|
||||||
|
Display a list of available bundles. Provide ways to add, edit and delete them.
|
||||||
|
|
||||||
|
=head3 $session
|
||||||
|
|
||||||
|
A WebGUI session object.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub www_manage {
|
||||||
|
my $session = shift;
|
||||||
|
return $session->privilege->insufficient() unless canView($session);
|
||||||
|
my $i18n = WebGUI::International->new($session, 'FilePump');
|
||||||
|
my $error = shift;
|
||||||
|
my $rows = '';
|
||||||
|
my $dt = $session->datetime;
|
||||||
|
my $url = $session->url;
|
||||||
|
my $getABundle = WebGUI::FilePump::Bundle->getAllIterator($session,{ orderBy => 'bundleName' } );
|
||||||
|
my $notYet = $i18n->get('not yet');
|
||||||
|
while (my $bundle = $getABundle->()) {
|
||||||
|
my $lastModified = $bundle->get('lastModified');
|
||||||
|
my $lastBuild = $bundle->get('lastBuild');
|
||||||
|
my $build = '';
|
||||||
|
if ($lastModified > $lastBuild) {
|
||||||
|
$build = sprintf q| <a href="%s">(%s)</a>|,
|
||||||
|
$url->gateway($url->getRequestedUrl,'op=filePump;func=buildBundle;bundleId='.$bundle->getId),
|
||||||
|
$i18n->get('build');
|
||||||
|
}
|
||||||
|
$rows .= sprintf '<tr><td>%s</td><td><a href="%s">%s</a></td><td>%s</td><td>%s</td>',
|
||||||
|
$session->icon->delete('op=filePump;func=deleteBundle;bundleId='.$bundle->getId),
|
||||||
|
$url->gateway($url->getRequestedUrl,'op=filePump;func=editBundle;bundleId='.$bundle->getId),
|
||||||
|
$bundle->get('bundleName'),
|
||||||
|
$bundle->get('lastModified') ? $dt->epochToHuman($lastModified) : $notYet,
|
||||||
|
$bundle->get('lastBuild') ? $dt->epochToHuman($lastBuild).$build : $notYet,
|
||||||
|
;
|
||||||
|
}
|
||||||
|
my $output = sprintf <<EOHTML, $i18n->get('bundle name'), $i18n->get('last modified'), $i18n->get('last build'), $rows;
|
||||||
|
<table border="1">
|
||||||
|
<tr><th> </th><th>%s</th><th>%s</th><th>%s</th></tr>
|
||||||
|
%s
|
||||||
|
</table>
|
||||||
|
EOHTML
|
||||||
|
my $ac = WebGUI::AdminConsole->new($session,'filePump');
|
||||||
|
$ac->addSubmenuItem($session->url->page('op=filePump;func=addBundle'), $i18n->get('add a bundle'));
|
||||||
|
return $ac->render($error.$output, 'File Pump');
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
1;
|
||||||
837
lib/WebGUI/FilePump/Bundle.pm
Normal file
837
lib/WebGUI/FilePump/Bundle.pm
Normal file
|
|
@ -0,0 +1,837 @@
|
||||||
|
package WebGUI::FilePump::Bundle;
|
||||||
|
|
||||||
|
use base qw/WebGUI::Crud/;
|
||||||
|
use WebGUI::International;
|
||||||
|
use WebGUI::Utility;
|
||||||
|
use URI;
|
||||||
|
use Path::Class;
|
||||||
|
use CSS::Minifier::XS;
|
||||||
|
use JavaScript::Minifier::XS;
|
||||||
|
use LWP;
|
||||||
|
use Data::Dumper;
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 addFile ( $type, $uri )
|
||||||
|
|
||||||
|
Adds a file of the requested type to the bundle. Returns 1 if the add was successful.
|
||||||
|
Otherwise, returns 0 and an error message as to why it was not successful.
|
||||||
|
|
||||||
|
=head3 $type
|
||||||
|
|
||||||
|
If $type is JS, it adds it to the javascript part of the bundle. If it is
|
||||||
|
CSS, it adds it to the CSS part of the bundle. OTHER is used for all other
|
||||||
|
types of files.
|
||||||
|
|
||||||
|
=head3 $uri
|
||||||
|
|
||||||
|
A URI to the new file to add. If the URI already exists in that part of the bundle,
|
||||||
|
it will return 0 and an error message.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub addFile {
|
||||||
|
my ($self, $type, $uri) = @_;
|
||||||
|
return 0, 'Illegal type' unless WebGUI::Utility::isIn($type, 'JS', 'CSS', 'OTHER');
|
||||||
|
return 0, 'No URI' unless $uri;
|
||||||
|
my $collateralType = $type eq 'JS' ? 'jsFiles'
|
||||||
|
: $type eq 'CSS' ? 'cssFiles'
|
||||||
|
: 'otherFiles';
|
||||||
|
my $files = $self->get($collateralType);
|
||||||
|
my $uriExists = $self->getCollateralDataIndex($files, 'uri', $uri) != -1 ? 1 : 0;
|
||||||
|
return 0, 'Duplicate URI' if $uriExists;
|
||||||
|
$self->setCollateral(
|
||||||
|
$collateralType,
|
||||||
|
'fileId',
|
||||||
|
'new',
|
||||||
|
{
|
||||||
|
uri => $uri,
|
||||||
|
lastModified => 0,
|
||||||
|
},
|
||||||
|
);
|
||||||
|
$self->update({lastModified => time()});
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 build ( )
|
||||||
|
|
||||||
|
build goes through and fetches all files referenced in all URIs stored for
|
||||||
|
this bundle. It downloads them, stores their modification time for future
|
||||||
|
checks, and then does special processing, depending on the type of file.
|
||||||
|
|
||||||
|
Javascript files are concatenated together in order, and minimized. The
|
||||||
|
resulting data is stored in the filepump area under the uploads directory
|
||||||
|
with the name bundleName.timestamp/bundleName.js
|
||||||
|
|
||||||
|
CSS files are handled likewise, except that the name is bundleName.timestamp/bundleName.css.
|
||||||
|
|
||||||
|
Other files are copied from their current location into the timestamped bundle directory.
|
||||||
|
|
||||||
|
Older timestamped build directories are removed.
|
||||||
|
|
||||||
|
If the build is successful, it will return 1. Otherwise, if problems
|
||||||
|
occur during the build, then the old build directory is not affected and
|
||||||
|
the method returns 0, along with an error message.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub build {
|
||||||
|
my ($self) = @_;
|
||||||
|
my $newBuild = time();
|
||||||
|
my $originalBuild = $self->get('lastBuild');
|
||||||
|
|
||||||
|
##Whole lot of building
|
||||||
|
my $error = undef;
|
||||||
|
|
||||||
|
##JavaScript first
|
||||||
|
my $jsFiles = $self->get('jsFiles');
|
||||||
|
my $concatenatedJS = '';
|
||||||
|
JSFILE: foreach my $jsFile (@{ $jsFiles }) {
|
||||||
|
my $uri = $jsFile->{uri};
|
||||||
|
my $results = $self->fetch($uri);
|
||||||
|
if (! $results->{content}) {
|
||||||
|
$error = $uri;
|
||||||
|
last JSFILE;
|
||||||
|
}
|
||||||
|
$concatenatedJS .= $results->{content};
|
||||||
|
$jsFile->{lastModified} = $results->{lastModified};
|
||||||
|
}
|
||||||
|
return (0, $error) if ($error);
|
||||||
|
|
||||||
|
##CSS next
|
||||||
|
my $cssFiles = $self->get('cssFiles');
|
||||||
|
my $concatenatedCSS = '';
|
||||||
|
CSSFILE: foreach my $cssFile (@{ $cssFiles }) {
|
||||||
|
my $uri = $cssFile->{uri};
|
||||||
|
my $results = $self->fetch($uri);
|
||||||
|
if (! $results->{content}) {
|
||||||
|
$error = $uri;
|
||||||
|
last CSSFILE;
|
||||||
|
}
|
||||||
|
$concatenatedCSS .= $results->{content};
|
||||||
|
$cssFile->{lastModified} = $results->{lastModified};
|
||||||
|
}
|
||||||
|
|
||||||
|
return (0, $error) if ($error);
|
||||||
|
|
||||||
|
##Create the new build directory
|
||||||
|
my $newDir = $self->getPathClassDir($newBuild);
|
||||||
|
my $mkpathErrors;
|
||||||
|
my $dirsCreated = $newDir->mkpath({ errors => $mkpathErrors });
|
||||||
|
if (! $dirsCreated) {
|
||||||
|
$newDir->rmtree;
|
||||||
|
my $errorMessages = join "\n", @{ $mkpathErrors };
|
||||||
|
return (0, $errorMessages);
|
||||||
|
}
|
||||||
|
|
||||||
|
##Minimize files, and write them out.
|
||||||
|
|
||||||
|
my $minimizedJS = JavaScript::Minifier::XS::minify($concatenatedJS);
|
||||||
|
undef $concatenatedJS;
|
||||||
|
|
||||||
|
my $minimizedCSS = CSS::Minifier::XS::minify($concatenatedCSS);
|
||||||
|
undef $concatenatedCSS;
|
||||||
|
|
||||||
|
my $flatJsFile = $newDir->file($self->bundleUrl . '.js');
|
||||||
|
my $jsFH = $flatJsFile->open('>');
|
||||||
|
print $jsFH $minimizedJS;
|
||||||
|
close $jsFH;
|
||||||
|
|
||||||
|
my $flatCssFile = $newDir->file($self->bundleUrl . '.css');
|
||||||
|
my $cssFH = $flatCssFile->open('>');
|
||||||
|
print $cssFH $minimizedCSS;
|
||||||
|
close $cssFH;
|
||||||
|
|
||||||
|
##Delete the old build directory and update myself with the new data.
|
||||||
|
$self->deleteBuild();
|
||||||
|
$self->update({
|
||||||
|
jsFiles => $jsFiles,
|
||||||
|
cssFiles => $cssFiles,
|
||||||
|
lastBuild => $newBuild,
|
||||||
|
});
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 crud_definition
|
||||||
|
|
||||||
|
WebGUI::Crud definition for this class.
|
||||||
|
|
||||||
|
=head3 tableName
|
||||||
|
|
||||||
|
filePumpBundle
|
||||||
|
|
||||||
|
=head3 tableKey
|
||||||
|
|
||||||
|
bundleId
|
||||||
|
|
||||||
|
=head3 sequenceKey
|
||||||
|
|
||||||
|
None. Bundles have no sequence amongst themselves.
|
||||||
|
|
||||||
|
=head3 properties
|
||||||
|
|
||||||
|
=head4 bundleName
|
||||||
|
|
||||||
|
The name of a bundle
|
||||||
|
|
||||||
|
=head4 lastBuild
|
||||||
|
|
||||||
|
The date the bundle was last built. This is used to generate the name of the bundled files
|
||||||
|
for this bundle.
|
||||||
|
|
||||||
|
=head4 lastModified
|
||||||
|
|
||||||
|
The date the bundle was last modified. With this, and the lastBuild date, you can determine
|
||||||
|
which bundles need to be rebuilt.
|
||||||
|
|
||||||
|
=head4 jsFiles, cssFiles, otherFiles
|
||||||
|
|
||||||
|
JSON blobs with files attached to the bundle. js = javascript, css = Cascading Style Sheets, other
|
||||||
|
means anything else.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub crud_definition {
|
||||||
|
my ($class, $session) = @_;
|
||||||
|
my $definition = $class->SUPER::crud_definition($session);
|
||||||
|
my $i18n = WebGUI::International->new($session, 'FilePump');
|
||||||
|
$definition->{tableName} = 'filePumpBundle';
|
||||||
|
$definition->{tableKey} = 'bundleId';
|
||||||
|
$definition->{sequenceKey} = '';
|
||||||
|
my $properties = $definition->{properties};
|
||||||
|
$properties->{bundleName} = {
|
||||||
|
fieldType => 'text',
|
||||||
|
defaultValue => $i18n->get('new bundle'),
|
||||||
|
};
|
||||||
|
$properties->{lastModified} = {
|
||||||
|
fieldType => 'integer',
|
||||||
|
defaultValue => 0,
|
||||||
|
};
|
||||||
|
$properties->{lastBuild} = {
|
||||||
|
fieldType => 'integer',
|
||||||
|
defaultValue => 0,
|
||||||
|
};
|
||||||
|
$properties->{jsFiles} = {
|
||||||
|
fieldType => 'textarea',
|
||||||
|
defaultValue => [],
|
||||||
|
serialize => 1,
|
||||||
|
};
|
||||||
|
$properties->{cssFiles} = {
|
||||||
|
fieldType => 'textarea',
|
||||||
|
defaultValue => [],
|
||||||
|
serialize => 1,
|
||||||
|
};
|
||||||
|
$properties->{otherFiles} = {
|
||||||
|
fieldType => 'textarea',
|
||||||
|
defaultValue => [],
|
||||||
|
serialize => 1,
|
||||||
|
};
|
||||||
|
return $definition;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 delete ( )
|
||||||
|
|
||||||
|
Extend the method from WebGUI::Crud to handle deleting the locally stored
|
||||||
|
files.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub delete {
|
||||||
|
my ($self) = @_;
|
||||||
|
$self->deleteBuild;
|
||||||
|
return $self->SUPER::delete;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 deleteBuild ( )
|
||||||
|
|
||||||
|
Delete the build as specified by the Bundle's current lastBuild timestamp;
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub deleteBuild {
|
||||||
|
my ($self) = @_;
|
||||||
|
my $bundleDir = $self->getPathClassDir();
|
||||||
|
$bundleDir->rmtree();
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 deleteCollateral ( tableName, keyName, keyValue )
|
||||||
|
|
||||||
|
Deletes a row of collateral data.
|
||||||
|
|
||||||
|
=head3 tableName
|
||||||
|
|
||||||
|
The name of the table you wish to delete the data from.
|
||||||
|
|
||||||
|
=head3 keyName
|
||||||
|
|
||||||
|
The name of a key in the collateral hash. Typically a unique identifier for a given
|
||||||
|
"row" of collateral data.
|
||||||
|
|
||||||
|
=head3 keyValue
|
||||||
|
|
||||||
|
Along with keyName, determines which "row" of collateral data to delete.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub deleteCollateral {
|
||||||
|
my $self = shift;
|
||||||
|
my $tableName = shift;
|
||||||
|
my $keyName = shift;
|
||||||
|
my $keyValue = shift;
|
||||||
|
my $table = $self->get($tableName);
|
||||||
|
my $index = $self->getCollateralDataIndex($table, $keyName, $keyValue);
|
||||||
|
return if $index == -1;
|
||||||
|
splice @{ $table }, $index, 1;
|
||||||
|
$self->update({ $tableName => $table });
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 deleteFiles ( $type )
|
||||||
|
|
||||||
|
Deletes all files of the requested type.
|
||||||
|
|
||||||
|
=head3 $type
|
||||||
|
|
||||||
|
If $type is JS, it deletes it from the javascript part of the bundle. If it is
|
||||||
|
CSS, it deletes it from the CSS part of the bundle. OTHER is used for all other
|
||||||
|
types of files.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub deleteFiles {
|
||||||
|
my ($self, $type) = @_;
|
||||||
|
return 0, 'Illegal type' unless WebGUI::Utility::isIn($type, 'JS', 'CSS', 'OTHER');
|
||||||
|
my $collateralType = $type eq 'JS' ? 'jsFiles'
|
||||||
|
: $type eq 'CSS' ? 'cssFiles'
|
||||||
|
: 'otherFiles';
|
||||||
|
$self->update({$collateralType => []});
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 deleteFile ( $type, $fileId )
|
||||||
|
|
||||||
|
Deletes a file of the requested type from the bundle.
|
||||||
|
|
||||||
|
=head3 $type
|
||||||
|
|
||||||
|
If $type is JS, it deletes it from the javascript part of the bundle. If it is
|
||||||
|
CSS, it deletes it from the CSS part of the bundle. OTHER is used for all other
|
||||||
|
types of files.
|
||||||
|
|
||||||
|
=head3 $fileId
|
||||||
|
|
||||||
|
The unique collateral GUID to delete from the bundle.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub deleteFile {
|
||||||
|
my ($self, $type, $fileId) = @_;
|
||||||
|
return 0, 'Illegal type' unless WebGUI::Utility::isIn($type, 'JS', 'CSS', 'OTHER');
|
||||||
|
return 0, 'No fileId' unless $fileId;
|
||||||
|
my $collateralType = $type eq 'JS' ? 'jsFiles'
|
||||||
|
: $type eq 'CSS' ? 'cssFiles'
|
||||||
|
: 'otherFiles';
|
||||||
|
$self->deleteCollateral(
|
||||||
|
$collateralType,
|
||||||
|
'fileId',
|
||||||
|
$fileId,
|
||||||
|
);
|
||||||
|
$self->update({lastModified => time()});
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 fetch ( $uri )
|
||||||
|
|
||||||
|
Based on the scheme of the URI, dispatch the URI to the correct method
|
||||||
|
to handle it. Returns the results of the method.
|
||||||
|
|
||||||
|
=head3 $uri
|
||||||
|
|
||||||
|
A uri, of the form accepted by URI.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub fetch {
|
||||||
|
my ($self, $uri ) = @_;
|
||||||
|
my $guts = {};
|
||||||
|
my $urio = URI->new($uri);
|
||||||
|
my $scheme = $urio->scheme;
|
||||||
|
if ($scheme eq 'http' or $scheme eq 'https') {
|
||||||
|
$guts = $self->fetchHttp($urio);
|
||||||
|
}
|
||||||
|
elsif ($scheme eq 'asset') {
|
||||||
|
$guts = $self->fetchAsset($urio);
|
||||||
|
}
|
||||||
|
elsif ($scheme eq 'file') {
|
||||||
|
$guts = $self->fetchFile($urio);
|
||||||
|
}
|
||||||
|
return $guts;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 fetchAsset ( $uri )
|
||||||
|
|
||||||
|
Fetches a bundle file from a WebGUI Asset (probably a snippet) in this site.
|
||||||
|
If the Asset cannot be found with that URL, it returns an empty hashref.
|
||||||
|
Depending on the type of Asset fetched, there will be different fields. Every
|
||||||
|
kind of asset will have the lastModified field.
|
||||||
|
|
||||||
|
Snippet assets will have a content field with the contents of the Snippet inside
|
||||||
|
of it.
|
||||||
|
|
||||||
|
File assets will have a content field with the contents of the file.
|
||||||
|
|
||||||
|
Any other kind of asset will return an empty content field.
|
||||||
|
|
||||||
|
=head3 $uri
|
||||||
|
|
||||||
|
A URI object.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub fetchAsset {
|
||||||
|
my ($self, $uri ) = @_;
|
||||||
|
|
||||||
|
my $url = $uri->opaque;
|
||||||
|
$url =~ s{^/+}{};
|
||||||
|
my $asset = WebGUI::Asset->newByUrl($self->session, $url);
|
||||||
|
return {} unless $asset;
|
||||||
|
##Check for a snippet, or snippet subclass?
|
||||||
|
my $guts = {
|
||||||
|
lastModified => $asset->get('lastModified'),
|
||||||
|
content => '',
|
||||||
|
};
|
||||||
|
if ($asset->isa('WebGUI::Asset::Snippet')) {
|
||||||
|
$guts->{content} = $asset->view(1);
|
||||||
|
}
|
||||||
|
elsif ($asset->isa('WebGUI::Asset::File')) {
|
||||||
|
$guts->{content} = $asset->getStorageLocation->getFileContentsAsScalar($asset->get('filename'));
|
||||||
|
}
|
||||||
|
return $guts;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 fetchFile ( $uri )
|
||||||
|
|
||||||
|
Fetches a bundle file from the local filesystem. Returns a hashref
|
||||||
|
with the content and date that it was last updated. If there is any problem
|
||||||
|
with getting the file, it returns an empty hashref.
|
||||||
|
|
||||||
|
=head3 $uri
|
||||||
|
|
||||||
|
A URI object.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub fetchFile {
|
||||||
|
my ($self, $uri ) = @_;
|
||||||
|
my $filepath = $uri->path;
|
||||||
|
return {} unless (-e $filepath && -r _);
|
||||||
|
my @stats = stat(_); # recycle stat data from file tests.
|
||||||
|
open my $file, '<', $filepath or return {};
|
||||||
|
local $/;
|
||||||
|
my $guts = {
|
||||||
|
lastModified => $stats[9],
|
||||||
|
content => <$file>,
|
||||||
|
};
|
||||||
|
close $file;
|
||||||
|
return $guts;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 fetchHttp ( $uri )
|
||||||
|
|
||||||
|
Fetches a bundle file from the web. Returns a hashref with the content
|
||||||
|
and date that it was last updated. If there is any problem with making
|
||||||
|
the request, it returns an empty hashref.
|
||||||
|
|
||||||
|
=head3 $uri
|
||||||
|
|
||||||
|
A URI object.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub fetchHttp {
|
||||||
|
my ($self, $uri ) = @_;
|
||||||
|
|
||||||
|
# Set up LWP
|
||||||
|
my $userAgent = LWP::UserAgent->new;
|
||||||
|
$userAgent->env_proxy;
|
||||||
|
$userAgent->agent("WebGUI");
|
||||||
|
|
||||||
|
# Create a request and stuff the uri in it
|
||||||
|
my $request = HTTP::Request->new( GET => $uri );
|
||||||
|
my $response = $userAgent->request($request);
|
||||||
|
|
||||||
|
if (! $response->is_success) {
|
||||||
|
return {};
|
||||||
|
}
|
||||||
|
my $guts = {
|
||||||
|
content => $response->content,
|
||||||
|
lastModified => $response->header('last-modified'),
|
||||||
|
};
|
||||||
|
return $guts;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 bundleUrl ( )
|
||||||
|
|
||||||
|
Returns a urlized version of the bundle name, safe for URLs and filenames.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub bundleUrl {
|
||||||
|
my ($self) = @_;
|
||||||
|
return $self->session->url->urlize($self->get('bundleName'));
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 getCollateral ( tableName, keyName, keyValue )
|
||||||
|
|
||||||
|
Returns a hash reference containing one row of collateral data from a particular
|
||||||
|
table.
|
||||||
|
|
||||||
|
=head3 tableName
|
||||||
|
|
||||||
|
The name of the table you wish to retrieve the data from.
|
||||||
|
|
||||||
|
=head3 keyName
|
||||||
|
|
||||||
|
The name of a key in the collateral hash. Typically a unique identifier for a given
|
||||||
|
"row" of collateral data.
|
||||||
|
|
||||||
|
=head3 keyValue
|
||||||
|
|
||||||
|
Along with keyName, determines which "row" of collateral data to get.
|
||||||
|
If this is equal to "new", then an empty hashRef will be returned to avoid
|
||||||
|
strict errors in the caller. If the requested data does not exist in the
|
||||||
|
collateral array, it also returns an empty hashRef.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub getCollateral {
|
||||||
|
my $self = shift;
|
||||||
|
my $tableName = shift;
|
||||||
|
my $keyName = shift;
|
||||||
|
my $keyValue = shift;
|
||||||
|
if ($keyValue eq "new" || $keyValue eq "") {
|
||||||
|
return {};
|
||||||
|
}
|
||||||
|
my $table = $self->get($tableName);
|
||||||
|
my $index = $self->getCollateralDataIndex($table, $keyName, $keyValue);
|
||||||
|
return {} if $index == -1;
|
||||||
|
my %copy = %{ $table->[$index] };
|
||||||
|
return \%copy;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 getCollateralDataIndex ( table, keyName, keyValue )
|
||||||
|
|
||||||
|
Returns the index in a set of collateral where an element of the
|
||||||
|
data (keyName) has a certain value (keyValue). If the criteria
|
||||||
|
are not found, returns -1.
|
||||||
|
|
||||||
|
=head3 table
|
||||||
|
|
||||||
|
The collateral data to search
|
||||||
|
|
||||||
|
=head3 keyName
|
||||||
|
|
||||||
|
The name of a key in the collateral hash.
|
||||||
|
|
||||||
|
=head3 keyValue
|
||||||
|
|
||||||
|
The value that keyName should have to meet the criteria.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub getCollateralDataIndex {
|
||||||
|
my $self = shift;
|
||||||
|
my $table = shift;
|
||||||
|
my $keyName = shift;
|
||||||
|
my $keyValue = shift;
|
||||||
|
for (my $index=0; $index <= $#{ $table }; $index++) {
|
||||||
|
return $index
|
||||||
|
if (exists($table->[$index]->{$keyName}) && ($table->[$index]->{$keyName} eq $keyValue ));
|
||||||
|
}
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 getPathClassDir ( $otherBuild )
|
||||||
|
|
||||||
|
Returns a Path::Class::Dir object to the last build directory
|
||||||
|
for this bundle.
|
||||||
|
|
||||||
|
=head3 $otherBuild
|
||||||
|
|
||||||
|
Another time stamp to use instead of the lastModified timestamp.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub getPathClassDir {
|
||||||
|
my ($self, $lastBuild) = @_;
|
||||||
|
$lastBuild ||= $self->get('lastBuild');
|
||||||
|
return Path::Class::Dir->new(
|
||||||
|
$self->session->config->get('uploadsPath'),
|
||||||
|
'filepump',
|
||||||
|
$self->bundleUrl . '.' . $lastBuild
|
||||||
|
);
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 getOutOfDateBundles ( $session )
|
||||||
|
|
||||||
|
This is a class method. It returns an array reference of WebGUI::FilePump::Bundle
|
||||||
|
objects that need to be rebuilt.
|
||||||
|
|
||||||
|
=head3 $session
|
||||||
|
|
||||||
|
A WebGUI::Session object.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub getOutOfDateBundles {
|
||||||
|
my ($class, $session) = @_;
|
||||||
|
my $oldBundles = [];
|
||||||
|
my $oldBundleIterator = $class->getAllIterator({
|
||||||
|
constraints => [
|
||||||
|
'lastBuild < lastModified' => [],
|
||||||
|
],
|
||||||
|
});
|
||||||
|
while (my $bundle = $oldBundleIterator->()) {
|
||||||
|
push @{ $oldBundles }, $bundle;
|
||||||
|
}
|
||||||
|
return $oldBundles;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 moveCollateralDown ( tableName, keyName, keyValue )
|
||||||
|
|
||||||
|
Moves a collateral data item down one position. If called on the last element of the
|
||||||
|
collateral array then it does nothing. Returns 1 if the move is successful. Returns
|
||||||
|
undef or the empty array otherwise.
|
||||||
|
|
||||||
|
=head3 tableName
|
||||||
|
|
||||||
|
A string indicating the table that contains the collateral data.
|
||||||
|
|
||||||
|
=head3 keyName
|
||||||
|
|
||||||
|
The name of a key in the collateral hash. Typically a unique identifier for a given
|
||||||
|
"row" of collateral data.
|
||||||
|
|
||||||
|
=head3 keyValue
|
||||||
|
|
||||||
|
Along with keyName, determines which "row" of collateral data to move.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub moveCollateralDown {
|
||||||
|
my $self = shift;
|
||||||
|
my $tableName = shift;
|
||||||
|
my $keyName = shift;
|
||||||
|
my $keyValue = shift;
|
||||||
|
|
||||||
|
my $table = $self->get($tableName);
|
||||||
|
my $index = $self->getCollateralDataIndex($table, $keyName, $keyValue);
|
||||||
|
return if $index == -1;
|
||||||
|
return unless (abs($index) < $#{$table});
|
||||||
|
@{ $table }[$index,$index+1] = @{ $table }[$index+1,$index];
|
||||||
|
$self->update({ $tableName => $table });
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 moveCollateralUp ( tableName, keyName, keyValue )
|
||||||
|
|
||||||
|
Moves a collateral data item up one position. If called on the first element of the
|
||||||
|
collateral array then it does nothing. Returns 1 if the move is successful. Returns
|
||||||
|
undef or the empty array otherwise.
|
||||||
|
|
||||||
|
|
||||||
|
=head3 tableName
|
||||||
|
|
||||||
|
A string indicating the table that contains the collateral data.
|
||||||
|
|
||||||
|
=head3 keyName
|
||||||
|
|
||||||
|
The name of a key in the collateral hash. Typically a unique identifier for a given
|
||||||
|
"row" of collateral data.
|
||||||
|
|
||||||
|
=head3 keyValue
|
||||||
|
|
||||||
|
Along with keyName, determines which "row" of collateral data to move.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub moveCollateralUp {
|
||||||
|
my $self = shift;
|
||||||
|
my $tableName = shift;
|
||||||
|
my $keyName = shift;
|
||||||
|
my $keyValue = shift;
|
||||||
|
|
||||||
|
my $table = $self->get($tableName);
|
||||||
|
my $index = $self->getCollateralDataIndex($table, $keyName, $keyValue);
|
||||||
|
return if $index == -1;
|
||||||
|
return unless $index && (abs($index) <= $#{$table});
|
||||||
|
@{ $table }[$index-1,$index] = @{ $table }[$index,$index-1];
|
||||||
|
$self->update({ $tableName => $table });
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 moveFileDown ( $type, $fileId )
|
||||||
|
|
||||||
|
Moves the requested file down in the ordered collateral.
|
||||||
|
|
||||||
|
=head3 $type
|
||||||
|
|
||||||
|
If $type is JS, it moves a file in the javascript part of the bundle. If it is
|
||||||
|
CSS, it moves a file in the CSS part of the bundle. OTHER is used for all other
|
||||||
|
types of files.
|
||||||
|
|
||||||
|
=head3 $fileId
|
||||||
|
|
||||||
|
The unique collateral GUID to move in the bundle.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub moveFileDown {
|
||||||
|
my ($self, $type, $fileId) = @_;
|
||||||
|
return 0, 'Illegal type' unless WebGUI::Utility::isIn($type, 'JS', 'CSS', 'OTHER');
|
||||||
|
return 0, 'No fileId' unless $fileId;
|
||||||
|
my $collateralType = $type eq 'JS' ? 'jsFiles'
|
||||||
|
: $type eq 'CSS' ? 'cssFiles'
|
||||||
|
: 'otherFiles';
|
||||||
|
$self->moveCollateralDown(
|
||||||
|
$collateralType,
|
||||||
|
'fileId',
|
||||||
|
$fileId,
|
||||||
|
);
|
||||||
|
$self->update({lastModified => time()});
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 moveFileUp ( $type, $fileId )
|
||||||
|
|
||||||
|
Moves the requested file up in the ordered collateral.
|
||||||
|
|
||||||
|
=head3 $type
|
||||||
|
|
||||||
|
If $type is JS, it moves a file in the javascript part of the bundle. If it is
|
||||||
|
CSS, it moves a file in the CSS part of the bundle. OTHER is used for all other
|
||||||
|
types of files.
|
||||||
|
|
||||||
|
=head3 $fileId
|
||||||
|
|
||||||
|
The unique collateral GUID to move in the bundle.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub moveFileUp {
|
||||||
|
my ($self, $type, $fileId) = @_;
|
||||||
|
return 0, 'Illegal type' unless WebGUI::Utility::isIn($type, 'JS', 'CSS', 'OTHER');
|
||||||
|
return 0, 'No fileId' unless $fileId;
|
||||||
|
my $collateralType = $type eq 'JS' ? 'jsFiles'
|
||||||
|
: $type eq 'CSS' ? 'cssFiles'
|
||||||
|
: 'otherFiles';
|
||||||
|
$self->moveCollateralUp(
|
||||||
|
$collateralType,
|
||||||
|
'fileId',
|
||||||
|
$fileId,
|
||||||
|
);
|
||||||
|
$self->update({lastModified => time()});
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#-----------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 setCollateral ( tableName, keyName, keyValue, properties )
|
||||||
|
|
||||||
|
Performs and insert/update of collateral data for any wobject's collateral data.
|
||||||
|
Returns the id of the data that was set, even if a new row was added to the
|
||||||
|
data.
|
||||||
|
|
||||||
|
=head3 tableName
|
||||||
|
|
||||||
|
The name of the table to insert the data.
|
||||||
|
|
||||||
|
=head3 keyName
|
||||||
|
|
||||||
|
The name of a key in the collateral hash. Typically a unique identifier for a given
|
||||||
|
"row" of collateral data.
|
||||||
|
|
||||||
|
=head3 keyValue
|
||||||
|
|
||||||
|
Along with keyName, determines which "row" of collateral data to set.
|
||||||
|
The index of the collateral data to set. If the keyValue = "new", then a
|
||||||
|
new entry will be appended to the end of the collateral array. Otherwise,
|
||||||
|
the appropriate entry will be overwritten with the new data.
|
||||||
|
|
||||||
|
=head3 properties
|
||||||
|
|
||||||
|
A hash reference containing the name/value pairs to be inserted into the collateral, using
|
||||||
|
the criteria mentioned above.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub setCollateral {
|
||||||
|
my $self = shift;
|
||||||
|
my $tableName = shift;
|
||||||
|
my $keyName = shift;
|
||||||
|
my $keyValue = shift;
|
||||||
|
my $properties = shift;
|
||||||
|
##Note, since this returns a reference, it is actually updating
|
||||||
|
##the object cache directly.
|
||||||
|
my $table = $self->get($tableName);
|
||||||
|
if ($keyValue eq 'new' || $keyValue eq '') {
|
||||||
|
if (! exists $properties->{$keyName}
|
||||||
|
or $properties->{$keyName} eq 'new'
|
||||||
|
or $properties->{$keyName} eq '') {
|
||||||
|
$properties->{$keyName} = $self->session->id->generate;
|
||||||
|
}
|
||||||
|
push @{ $table }, $properties;
|
||||||
|
$self->update({$tableName => $table});
|
||||||
|
return $properties->{$keyName};
|
||||||
|
}
|
||||||
|
my $index = $self->getCollateralDataIndex($table, $keyName, $keyValue);
|
||||||
|
return if $index == -1;
|
||||||
|
$table->[$index] = $properties;
|
||||||
|
$self->update({ $tableName => $table });
|
||||||
|
return $keyValue;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
1;
|
||||||
103
lib/WebGUI/Macro/FilePump.pm
Normal file
103
lib/WebGUI/Macro/FilePump.pm
Normal file
|
|
@ -0,0 +1,103 @@
|
||||||
|
package WebGUI::Macro::FilePump;
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
# 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
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use WebGUI::FilePump::Bundle;
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
Package WebGUI::Macro::Build
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
Macro to access FilePump bundle information.
|
||||||
|
|
||||||
|
=head2 process( $session, $bundleName, $type )
|
||||||
|
|
||||||
|
Deliver the bundle files. If in admin mode, give raw links to the files.
|
||||||
|
If not in admin mode, give links to the bundled, minified files.
|
||||||
|
|
||||||
|
=over 4
|
||||||
|
|
||||||
|
=item *
|
||||||
|
|
||||||
|
A session variable
|
||||||
|
|
||||||
|
=item *
|
||||||
|
|
||||||
|
$bundleName, the name of a File Pump bundle.
|
||||||
|
|
||||||
|
=item *
|
||||||
|
|
||||||
|
$type, the type of files from the Bundle that you are accessing. Either JS or javascript, or CSS or css.
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
sub process {
|
||||||
|
my $session = shift;
|
||||||
|
my $bundleName = shift;
|
||||||
|
my $type = shift;
|
||||||
|
$type = lc $type;
|
||||||
|
my $output = "";
|
||||||
|
|
||||||
|
my $bundleId = WebGUI::FilePump::Bundle->getAllIds($session, {
|
||||||
|
constraints => [ { 'bundleName = ?' => [$bundleName]}, ],
|
||||||
|
limit => 1,
|
||||||
|
});
|
||||||
|
return '' unless $bundleId and $bundleId->[0];
|
||||||
|
|
||||||
|
my $bundle = WebGUI::FilePump::Bundle->new($session, $bundleId);
|
||||||
|
return '' unless $bundle;
|
||||||
|
|
||||||
|
if (! $session->var->isAdminOn) {
|
||||||
|
my $dir = $bundle->getPathClassDir;
|
||||||
|
if ($type eq 'js' || $type eq 'javascript') {
|
||||||
|
my $file = $dir->file($bundle->bundleUrl . '.js');
|
||||||
|
return sprintf qq|<script type="type/javascript" src="%s">\n|, $file->stringify;
|
||||||
|
}
|
||||||
|
elsif ($type eq 'css') {
|
||||||
|
my $file = $dir->file($bundle->bundleUrl . '.css');
|
||||||
|
return sprintf qq|<link rel="stylesheet" type="type/css" href="%s">\n|, $file->stringify;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
return '';
|
||||||
|
}
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
my $template;
|
||||||
|
my $files;
|
||||||
|
if ($type eq 'js' || $type eq 'javascript') {
|
||||||
|
$template = qq|<script type="type/javascript" src="%s">\n|;
|
||||||
|
$files = $bundle->get('jsFiles');
|
||||||
|
}
|
||||||
|
elsif ($type eq 'css') {
|
||||||
|
$template = qq|<link rel="stylesheet" type="type/css" href="%s">\n|;
|
||||||
|
$files = $bundle->get('cssFiles');
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
return '';
|
||||||
|
}
|
||||||
|
foreach my $file (@{ $files }) {
|
||||||
|
$output .= sprintf $template, $file->{uri};
|
||||||
|
}
|
||||||
|
return $output;
|
||||||
|
}
|
||||||
|
return '';
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
|
|
||||||
|
#vim:ft=perl
|
||||||
|
|
@ -514,6 +514,7 @@ sub definition {
|
||||||
groupIdAdminCache
|
groupIdAdminCache
|
||||||
groupIdAdminCron
|
groupIdAdminCron
|
||||||
groupIdAdminDatabaseLink
|
groupIdAdminDatabaseLink
|
||||||
|
groupIdAdminFilePump
|
||||||
groupIdAdminGraphics
|
groupIdAdminGraphics
|
||||||
groupIdAdminGroup
|
groupIdAdminGroup
|
||||||
groupIdAdminGroupAdmin
|
groupIdAdminGroupAdmin
|
||||||
|
|
|
||||||
100
lib/WebGUI/i18n/English/FilePump.pm
Normal file
100
lib/WebGUI/i18n/English/FilePump.pm
Normal file
|
|
@ -0,0 +1,100 @@
|
||||||
|
package WebGUI::i18n::English::FilePump;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
|
||||||
|
our $I18N = {
|
||||||
|
|
||||||
|
'bundle name' => {
|
||||||
|
message => q|Bundle name|,
|
||||||
|
lastUpdated => 1131394070,
|
||||||
|
context => q|Label for the name of a bundle (group, clump) of files.|
|
||||||
|
},
|
||||||
|
|
||||||
|
'last build' => {
|
||||||
|
message => q|Last Build|,
|
||||||
|
lastUpdated => 1242493652,
|
||||||
|
context => q|The time the bundle was built last|
|
||||||
|
},
|
||||||
|
|
||||||
|
'last modified' => {
|
||||||
|
message => q|Last Modified|,
|
||||||
|
lastUpdated => 1242493669,
|
||||||
|
context => q|The time the bundle was last modified.|
|
||||||
|
},
|
||||||
|
|
||||||
|
'bundle name help' => {
|
||||||
|
message => q|A unique, human readable name for this bundle. Bundle names must be unique.|,
|
||||||
|
lastUpdated => 1131394072,
|
||||||
|
context => q|Hover help for bundle name.|
|
||||||
|
},
|
||||||
|
|
||||||
|
'new bundle' => {
|
||||||
|
message => q|New bundle|,
|
||||||
|
lastUpdated => 1131394072,
|
||||||
|
context => q|Hover help for bundle name.|
|
||||||
|
},
|
||||||
|
|
||||||
|
'File Pump' => {
|
||||||
|
message => q|File Pump|,
|
||||||
|
lastUpdated => 1242439269,
|
||||||
|
context => q|File Pump is a system for pushing out lots of files at once.|
|
||||||
|
},
|
||||||
|
|
||||||
|
'add a bundle' => {
|
||||||
|
message => q|Add a Bundle|,
|
||||||
|
lastUpdated => 1242439269,
|
||||||
|
context => q|Admin console label. Bundle is a loose set of similar, but not identical objects. Similar to pile.|
|
||||||
|
},
|
||||||
|
|
||||||
|
'Add Bundle' => {
|
||||||
|
message => q|Add Bundle|,
|
||||||
|
lastUpdated => 1242439269,
|
||||||
|
context => q|Admin console label. Bundle is a loose set of similar, but not identical objects. Similar to pile.|
|
||||||
|
},
|
||||||
|
|
||||||
|
'list bundles' => {
|
||||||
|
message => q|List Bundles|,
|
||||||
|
lastUpdated => 1242495011,
|
||||||
|
context => q|Admin console label. Bundle is a loose set of similar, but not identical objects. Similar to pile.|
|
||||||
|
},
|
||||||
|
|
||||||
|
'jsFiles' => {
|
||||||
|
message => q|JavaScript|,
|
||||||
|
lastUpdated => 1242495011,
|
||||||
|
context => q|Edit bundle label.|
|
||||||
|
},
|
||||||
|
|
||||||
|
'cssFiles' => {
|
||||||
|
message => q|CSS|,
|
||||||
|
lastUpdated => 1242495011,
|
||||||
|
context => q|Edit bundle label.|
|
||||||
|
},
|
||||||
|
|
||||||
|
'build this bundle' => {
|
||||||
|
message => q|Build this bundle|,
|
||||||
|
lastUpdated => 1242495011,
|
||||||
|
context => q|Edit bundle label.|
|
||||||
|
},
|
||||||
|
|
||||||
|
'build' => {
|
||||||
|
message => q|Build|,
|
||||||
|
lastUpdated => 1242495011,
|
||||||
|
context => q|List bundles label. Meaning to construct. The short version of Build this bundle.|
|
||||||
|
},
|
||||||
|
|
||||||
|
'build error' => {
|
||||||
|
message => q|Problem fetching this URI: %s|,
|
||||||
|
lastUpdated => 1242495011,
|
||||||
|
context => q|Edit bundle error label.|
|
||||||
|
},
|
||||||
|
|
||||||
|
'not yet' => {
|
||||||
|
message => q|Not yet|,
|
||||||
|
lastUpdated => 1242515308,
|
||||||
|
context => q|Meaning that something has not been done at this time. Before the first time.|
|
||||||
|
},
|
||||||
|
|
||||||
|
};
|
||||||
|
|
||||||
|
1;
|
||||||
|
#vim:ft=perl
|
||||||
|
|
@ -3818,6 +3818,15 @@ LongTruncOk=1</p>
|
||||||
lastUpdated => 0,
|
lastUpdated => 0,
|
||||||
},
|
},
|
||||||
|
|
||||||
|
'settings groupIdAdminFilePump label' => {
|
||||||
|
message => q{File Pump},
|
||||||
|
lastUpdated => 0,
|
||||||
|
},
|
||||||
|
'settings groupIdAdminFilePump hoverHelp' => {
|
||||||
|
message => q{Group to access and manage File Pump bundles.},
|
||||||
|
lastUpdated => 0,
|
||||||
|
},
|
||||||
|
|
||||||
|
|
||||||
'settings groupIdAdminGroupAdmin label' => {
|
'settings groupIdAdminGroupAdmin label' => {
|
||||||
message => q{Groups (limited)},
|
message => q{Groups (limited)},
|
||||||
|
|
|
||||||
|
|
@ -131,6 +131,8 @@ checkModule('Business::Tax::VAT::Validation', '0.20' );
|
||||||
checkModule('Crypt::SSLeay', '0.57' );
|
checkModule('Crypt::SSLeay', '0.57' );
|
||||||
checkModule('Scope::Guard', '0.03' );
|
checkModule('Scope::Guard', '0.03' );
|
||||||
checkModule('Digest::SHA', '5.47' );
|
checkModule('Digest::SHA', '5.47' );
|
||||||
|
checkModule("CSS::Minifier::XS", "0.03" );
|
||||||
|
checkModule("JavaScript::Minifier::XS", "0.05" );
|
||||||
|
|
||||||
failAndExit("Required modules are missing, running no more checks.") if $missingModule;
|
failAndExit("Required modules are missing, running no more checks.") if $missingModule;
|
||||||
|
|
||||||
|
|
|
||||||
366
t/FilePump/Bundle.t
Normal file
366
t/FilePump/Bundle.t
Normal file
|
|
@ -0,0 +1,366 @@
|
||||||
|
# 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
|
||||||
|
#------------------------------------------------------------------
|
||||||
|
|
||||||
|
# Write a little about what this script tests.
|
||||||
|
#
|
||||||
|
#
|
||||||
|
|
||||||
|
use FindBin;
|
||||||
|
use strict;
|
||||||
|
use lib "$FindBin::Bin/../lib";
|
||||||
|
use Test::More;
|
||||||
|
use Test::Deep;
|
||||||
|
use Data::Dumper;
|
||||||
|
use URI;
|
||||||
|
use WebGUI::Test; # Must use this before any other WebGUI modules
|
||||||
|
use WebGUI::Session;
|
||||||
|
|
||||||
|
my $startTime = time();
|
||||||
|
my $wgBday = 997966800;
|
||||||
|
|
||||||
|
#----------------------------------------------------------------------------
|
||||||
|
# Init
|
||||||
|
my $session = WebGUI::Test->session;
|
||||||
|
|
||||||
|
#----------------------------------------------------------------------------
|
||||||
|
# Tests
|
||||||
|
|
||||||
|
my $tests = 46; # Increment this number for each test you create
|
||||||
|
plan tests => 1 + $tests; # 1 for the use_ok
|
||||||
|
|
||||||
|
#----------------------------------------------------------------------------
|
||||||
|
# put your tests here
|
||||||
|
|
||||||
|
my $loaded = use_ok('WebGUI::FilePump::Bundle');
|
||||||
|
|
||||||
|
SKIP: {
|
||||||
|
|
||||||
|
skip 'Unable to load module WebGUI::FilePump::Bundle', $tests unless $loaded;
|
||||||
|
|
||||||
|
my $bundle = WebGUI::FilePump::Bundle->create($session);
|
||||||
|
isa_ok($bundle, 'WebGUI::FilePump::Bundle');
|
||||||
|
isa_ok($bundle, 'WebGUI::Crud');
|
||||||
|
|
||||||
|
is($bundle->get('lastModified'), 0, 'by default, lastModified is 0');
|
||||||
|
|
||||||
|
###################################################################
|
||||||
|
#
|
||||||
|
# addFile
|
||||||
|
#
|
||||||
|
###################################################################
|
||||||
|
|
||||||
|
cmp_deeply(
|
||||||
|
[ $bundle->addFile() ],
|
||||||
|
[ 0, 'Illegal type' ],
|
||||||
|
'addFile, checking error for no type'
|
||||||
|
);
|
||||||
|
|
||||||
|
cmp_deeply(
|
||||||
|
[ $bundle->addFile('BAD_TYPE', ) ],
|
||||||
|
[ 0, 'Illegal type' ],
|
||||||
|
'... checking error for bad type of file to add'
|
||||||
|
);
|
||||||
|
|
||||||
|
cmp_deeply(
|
||||||
|
[ $bundle->addFile('JS', ) ],
|
||||||
|
[ 0, 'No URI' ],
|
||||||
|
'... checking error for no uri'
|
||||||
|
);
|
||||||
|
|
||||||
|
is(
|
||||||
|
$bundle->addFile('JS', 'http://mysite.com/script.js'),
|
||||||
|
1,
|
||||||
|
'... adding a JS file'
|
||||||
|
);
|
||||||
|
cmp_ok($bundle->get('lastModified'), '>=', $startTime, '... updates lastModified');
|
||||||
|
|
||||||
|
is(
|
||||||
|
$bundle->addFile('CSS', 'http://mysite.com/script.js'),
|
||||||
|
1,
|
||||||
|
'... okay to add a duplicate to another type'
|
||||||
|
);
|
||||||
|
|
||||||
|
cmp_deeply(
|
||||||
|
[ $bundle->addFile('JS', 'http://mysite.com/script.js') ],
|
||||||
|
[ 0, 'Duplicate URI' ],
|
||||||
|
'... checking error message for duplicate URI'
|
||||||
|
);
|
||||||
|
|
||||||
|
$bundle->addFile('JS', 'http://mysite.com/helloworld.js');
|
||||||
|
$bundle->addFile('JS', 'file:/data/domains/mysite.com/www/uploads/XX/YY/XXYYZZ/graviticEnergyDrive.js');
|
||||||
|
|
||||||
|
my @fileUris = map { $_->{uri} } @{ $bundle->get('jsFiles') };
|
||||||
|
cmp_deeply(
|
||||||
|
[ @fileUris ],
|
||||||
|
[qw{
|
||||||
|
http://mysite.com/script.js
|
||||||
|
http://mysite.com/helloworld.js
|
||||||
|
file:/data/domains/mysite.com/www/uploads/XX/YY/XXYYZZ/graviticEnergyDrive.js
|
||||||
|
}],
|
||||||
|
'... checking actual jsFiles data structure contents'
|
||||||
|
);
|
||||||
|
|
||||||
|
###################################################################
|
||||||
|
#
|
||||||
|
# moveFile{Up,Down}
|
||||||
|
#
|
||||||
|
###################################################################
|
||||||
|
|
||||||
|
cmp_deeply(
|
||||||
|
[ $bundle->moveFileUp() ],
|
||||||
|
[ 0, 'Illegal type' ],
|
||||||
|
'moveFileUp: checking error for no type'
|
||||||
|
);
|
||||||
|
|
||||||
|
cmp_deeply(
|
||||||
|
[ $bundle->moveFileUp('BEER') ],
|
||||||
|
[ 0, 'Illegal type' ],
|
||||||
|
'... checking error for bad type'
|
||||||
|
);
|
||||||
|
|
||||||
|
cmp_deeply(
|
||||||
|
[ $bundle->moveFileUp('JS', ) ],
|
||||||
|
[ 0, 'No fileId' ],
|
||||||
|
'... checking error for no fileId'
|
||||||
|
);
|
||||||
|
|
||||||
|
cmp_deeply(
|
||||||
|
[ $bundle->moveFileDown() ],
|
||||||
|
[ 0, 'Illegal type' ],
|
||||||
|
'moveFileDown: checking error for no type'
|
||||||
|
);
|
||||||
|
|
||||||
|
cmp_deeply(
|
||||||
|
[ $bundle->moveFileDown('BEER') ],
|
||||||
|
[ 0, 'Illegal type' ],
|
||||||
|
'... checking error for bad type'
|
||||||
|
);
|
||||||
|
|
||||||
|
cmp_deeply(
|
||||||
|
[ $bundle->moveFileDown('JS', ) ],
|
||||||
|
[ 0, 'No fileId' ],
|
||||||
|
'... checking error for no fileId'
|
||||||
|
);
|
||||||
|
|
||||||
|
my @fileIds = map { $_->{fileId} } @{ $bundle->get('jsFiles') };
|
||||||
|
|
||||||
|
$bundle->update({lastModified => 0});
|
||||||
|
ok($bundle->moveFileDown('JS', $fileIds[0]), 'moveFileDown returns 1 for a successful move');
|
||||||
|
@fileUris = map { $_->{uri} } @{ $bundle->get('jsFiles') };
|
||||||
|
cmp_deeply(
|
||||||
|
[ @fileUris ],
|
||||||
|
[qw{
|
||||||
|
http://mysite.com/helloworld.js
|
||||||
|
http://mysite.com/script.js
|
||||||
|
file:/data/domains/mysite.com/www/uploads/XX/YY/XXYYZZ/graviticEnergyDrive.js
|
||||||
|
}],
|
||||||
|
'... checking the actual order of js files'
|
||||||
|
);
|
||||||
|
cmp_ok($bundle->get('lastModified'), '>=', $startTime, '... updates lastModified');
|
||||||
|
|
||||||
|
$bundle->update({lastModified => 0});
|
||||||
|
ok($bundle->moveFileUp('JS', $fileIds[2]), 'moveFileUp returns 1 for a successful move');
|
||||||
|
@fileUris = map { $_->{uri} } @{ $bundle->get('jsFiles') };
|
||||||
|
cmp_deeply(
|
||||||
|
[ @fileUris ],
|
||||||
|
[qw{
|
||||||
|
http://mysite.com/helloworld.js
|
||||||
|
file:/data/domains/mysite.com/www/uploads/XX/YY/XXYYZZ/graviticEnergyDrive.js
|
||||||
|
http://mysite.com/script.js
|
||||||
|
}],
|
||||||
|
'... checking the actual order of js files'
|
||||||
|
);
|
||||||
|
cmp_ok($bundle->get('lastModified'), '>=', $startTime, '... updates lastModified');
|
||||||
|
|
||||||
|
###################################################################
|
||||||
|
#
|
||||||
|
# deleteFile
|
||||||
|
#
|
||||||
|
###################################################################
|
||||||
|
|
||||||
|
cmp_deeply(
|
||||||
|
[ $bundle->deleteFile() ],
|
||||||
|
[ 0, 'Illegal type' ],
|
||||||
|
'deleteFile: checking error for no type'
|
||||||
|
);
|
||||||
|
|
||||||
|
cmp_deeply(
|
||||||
|
[ $bundle->deleteFile('BEER') ],
|
||||||
|
[ 0, 'Illegal type' ],
|
||||||
|
'... checking error for bad type'
|
||||||
|
);
|
||||||
|
|
||||||
|
cmp_deeply(
|
||||||
|
[ $bundle->deleteFile('JS', ) ],
|
||||||
|
[ 0, 'No fileId' ],
|
||||||
|
'... checking error for no fileId'
|
||||||
|
);
|
||||||
|
|
||||||
|
@fileIds = map { $_->{fileId} } @{ $bundle->get('jsFiles') };
|
||||||
|
$bundle->update({lastModified => 0});
|
||||||
|
$bundle->deleteFile('JS', $fileIds[1]);
|
||||||
|
@fileUris = map { $_->{uri} } @{ $bundle->get('jsFiles') };
|
||||||
|
cmp_deeply(
|
||||||
|
[ @fileUris ],
|
||||||
|
[qw{
|
||||||
|
http://mysite.com/helloworld.js
|
||||||
|
http://mysite.com/script.js
|
||||||
|
}],
|
||||||
|
'... checking the actual deletion of js files'
|
||||||
|
);
|
||||||
|
cmp_ok($bundle->get('lastModified'), '>=', $startTime, '... updates lastModified');
|
||||||
|
|
||||||
|
###################################################################
|
||||||
|
#
|
||||||
|
# fetch
|
||||||
|
#
|
||||||
|
###################################################################
|
||||||
|
|
||||||
|
my $root = WebGUI::Asset->getRoot($session);
|
||||||
|
|
||||||
|
my $snippet = $root->addChild({
|
||||||
|
className => 'WebGUI::Asset::Snippet',
|
||||||
|
url => 'filePumpSnippet',
|
||||||
|
snippet => 'Pump a Snippet',
|
||||||
|
});
|
||||||
|
|
||||||
|
my $fileAsset = $root->addChild({
|
||||||
|
className => 'WebGUI::Asset::File',
|
||||||
|
url => 'filePumpFileAsset',
|
||||||
|
filename => 'pumpfile',
|
||||||
|
});
|
||||||
|
|
||||||
|
$fileAsset->getStorageLocation->addFileFromScalar('pumpfile', 'Pump up the jam');
|
||||||
|
|
||||||
|
my $snippetTag = WebGUI::VersionTag->getWorking($session);
|
||||||
|
WebGUI::Test->tagsToRollback($snippetTag);
|
||||||
|
$snippetTag->commit;
|
||||||
|
|
||||||
|
my $guts;
|
||||||
|
$guts = $bundle->fetchAsset(URI->new('asset://filePumpSnippet'));
|
||||||
|
cmp_deeply(
|
||||||
|
$guts,
|
||||||
|
{
|
||||||
|
content => 'Pump a Snippet',
|
||||||
|
lastModified => re('^\d+$'),
|
||||||
|
},
|
||||||
|
'fetchAsset: retrieved a snippet'
|
||||||
|
);
|
||||||
|
|
||||||
|
$guts = $bundle->fetchAsset(URI->new('asset://filePumpFileAsset'));
|
||||||
|
cmp_deeply(
|
||||||
|
$guts,
|
||||||
|
{
|
||||||
|
content => 'Pump up the jam',
|
||||||
|
lastModified => re('^\d+$'),
|
||||||
|
},
|
||||||
|
'fetchAsset: retrieved a file asset'
|
||||||
|
);
|
||||||
|
|
||||||
|
my $path = $fileAsset->getStorageLocation->getPath($fileAsset->get('filename'));
|
||||||
|
my $urilet = URI->new('file:'.$path);
|
||||||
|
|
||||||
|
$guts = $bundle->fetchFile($urilet);
|
||||||
|
cmp_deeply(
|
||||||
|
$guts,
|
||||||
|
{
|
||||||
|
content => 'Pump up the jam',
|
||||||
|
lastModified => re('^\d+$'),
|
||||||
|
},
|
||||||
|
'fetchFile: retrieved a file from the filesystem'
|
||||||
|
);
|
||||||
|
|
||||||
|
###################################################################
|
||||||
|
#
|
||||||
|
# getPathClassDir
|
||||||
|
#
|
||||||
|
###################################################################
|
||||||
|
|
||||||
|
my $dir = $bundle->getPathClassDir();
|
||||||
|
isa_ok($dir, 'Path::Class::Dir');
|
||||||
|
my $timestampDir = $dir->dir_list(-1, 1);
|
||||||
|
cmp_deeply(
|
||||||
|
[ split /\./, $timestampDir ],
|
||||||
|
[ 'new-bundle', 0 ],
|
||||||
|
'... directory has correct name and timestamp'
|
||||||
|
);
|
||||||
|
|
||||||
|
$dir = $bundle->getPathClassDir($wgBday);
|
||||||
|
isa_ok($dir, 'Path::Class::Dir');
|
||||||
|
$timestampDir = $dir->dir_list(-1, 1);
|
||||||
|
cmp_deeply(
|
||||||
|
[ split /\./, $timestampDir ],
|
||||||
|
[ 'new-bundle', $wgBday ],
|
||||||
|
'... directory has correct name and timestamp when timestamp is specified'
|
||||||
|
);
|
||||||
|
|
||||||
|
###################################################################
|
||||||
|
#
|
||||||
|
# deleteFiles
|
||||||
|
#
|
||||||
|
###################################################################
|
||||||
|
|
||||||
|
$bundle->deleteFiles('JS');
|
||||||
|
$bundle->deleteFiles('CSS');
|
||||||
|
|
||||||
|
cmp_deeply($bundle->get('jsFiles'), [], ' deleteFiles deleted all JS URIs');
|
||||||
|
cmp_deeply($bundle->get('cssFiles'), [], ' ... deleted all CSS URIs');
|
||||||
|
|
||||||
|
###################################################################
|
||||||
|
#
|
||||||
|
# build
|
||||||
|
#
|
||||||
|
###################################################################
|
||||||
|
|
||||||
|
my $oldBuildDir = $bundle->getPathClassDir($wgBday);
|
||||||
|
$oldBuildDir->mkpath;
|
||||||
|
|
||||||
|
ok(-e $oldBuildDir->stringify && -d _, 'No problems creating old build directory');
|
||||||
|
$bundle->update({lastBuild => $wgBday});
|
||||||
|
|
||||||
|
$snippet->update({snippet => qq|\n\nfunction doNothing()\n{ var foo = 'bar';} |});
|
||||||
|
|
||||||
|
$fileAsset->getStorageLocation->deleteFile('pumpfile');
|
||||||
|
$fileAsset->getStorageLocation->addFileFromScalar('pumpfile.css', qq| body {\npadding: 0px;}\n\n|);
|
||||||
|
$fileAsset->update({filename => 'pumpfile.css'});
|
||||||
|
|
||||||
|
$bundle->addFile('JS', 'asset://filePumpSnippet');
|
||||||
|
$bundle->addFile('CSS', 'asset://filePumpFileAsset');
|
||||||
|
my ($buildFlag, $error) = $bundle->build();
|
||||||
|
ok($buildFlag, 'build returns true when there are no errors');
|
||||||
|
isnt($bundle->get('lastBuild'), $wgBday, '... lastBuild time updated');
|
||||||
|
|
||||||
|
my $buildDir = $bundle->getPathClassDir();
|
||||||
|
isnt($buildDir->stringify, $oldBuildDir->stringify, '... build directory did actually change');
|
||||||
|
ok(-e $buildDir->stringify && -d _, '... new build directory created');
|
||||||
|
ok(!-e $oldBuildDir->stringify && !-d _, '... old build directory deleted');
|
||||||
|
my $jsFile = $buildDir->file($bundle->bundleUrl . '.js');
|
||||||
|
my $cssFile = $buildDir->file($bundle->bundleUrl . '.css');
|
||||||
|
ok(-e $jsFile->stringify && -f _ && -s _, '... minified JS file built, not empty');
|
||||||
|
ok(-e $cssFile->stringify && -f _ && -s _, '... minified CSS file built, not empty');
|
||||||
|
|
||||||
|
###################################################################
|
||||||
|
#
|
||||||
|
# delete
|
||||||
|
#
|
||||||
|
###################################################################
|
||||||
|
|
||||||
|
$bundle->delete;
|
||||||
|
ok(!-e $buildDir->stringify && !-d _, 'delete deletes the current build directory deleted');
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
#----------------------------------------------------------------------------
|
||||||
|
# Cleanup
|
||||||
|
END {
|
||||||
|
$session->db->write('delete from filePumpBundle');
|
||||||
|
}
|
||||||
|
#vim:ft=perl
|
||||||
56
t/Macro/FilePump.t
Normal file
56
t/Macro/FilePump.t
Normal file
|
|
@ -0,0 +1,56 @@
|
||||||
|
# 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
|
||||||
|
#------------------------------------------------------------------
|
||||||
|
|
||||||
|
# Write a little about what this script tests.
|
||||||
|
#
|
||||||
|
#
|
||||||
|
|
||||||
|
use FindBin;
|
||||||
|
use strict;
|
||||||
|
use lib "$FindBin::Bin/../lib";
|
||||||
|
use Test::More;
|
||||||
|
use WebGUI::Test; # Must use this before any other WebGUI modules
|
||||||
|
use WebGUI::Session;
|
||||||
|
|
||||||
|
#----------------------------------------------------------------------------
|
||||||
|
# Init
|
||||||
|
my $session = WebGUI::Test->session;
|
||||||
|
|
||||||
|
|
||||||
|
#----------------------------------------------------------------------------
|
||||||
|
# Tests
|
||||||
|
|
||||||
|
my $tests = 0;
|
||||||
|
plan tests => 1 + $tests;
|
||||||
|
|
||||||
|
#----------------------------------------------------------------------------
|
||||||
|
# put your tests here
|
||||||
|
|
||||||
|
my $macro = 'WebGUI::Macro::FilePump';
|
||||||
|
my $loaded = use_ok($macro);
|
||||||
|
|
||||||
|
my $bundle = WebGUI::FilePump::Bundle->create($session, { bundleName => 'test bundle'});
|
||||||
|
|
||||||
|
SKIP: {
|
||||||
|
|
||||||
|
skip "Unable to load $macro", $tests unless $loaded;
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#----------------------------------------------------------------------------
|
||||||
|
# Cleanup
|
||||||
|
END {
|
||||||
|
|
||||||
|
$bundle->delete;
|
||||||
|
|
||||||
|
}
|
||||||
|
#vim:ft=perl
|
||||||
|
|
@ -56,6 +56,7 @@ my @groupsToDelete;
|
||||||
my @usersToDelete;
|
my @usersToDelete;
|
||||||
my @sessionsToDelete;
|
my @sessionsToDelete;
|
||||||
my @storagesToDelete;
|
my @storagesToDelete;
|
||||||
|
my @tagsToRollback;
|
||||||
|
|
||||||
BEGIN {
|
BEGIN {
|
||||||
|
|
||||||
|
|
@ -164,6 +165,9 @@ END {
|
||||||
$session->var->end;
|
$session->var->end;
|
||||||
$session->close;
|
$session->close;
|
||||||
}
|
}
|
||||||
|
foreach my $tag (@tagsToRollback) {
|
||||||
|
$tag->rollback;
|
||||||
|
}
|
||||||
if ($ENV{WEBGUI_TEST_DEBUG}) {
|
if ($ENV{WEBGUI_TEST_DEBUG}) {
|
||||||
$Test->diag('Sessions: '.$SESSION->db->quickScalar('select count(*) from userSession'));
|
$Test->diag('Sessions: '.$SESSION->db->quickScalar('select count(*) from userSession'));
|
||||||
$Test->diag('Scratch : '.$SESSION->db->quickScalar('select count(*) from userSessionScratch'));
|
$Test->diag('Scratch : '.$SESSION->db->quickScalar('select count(*) from userSessionScratch'));
|
||||||
|
|
@ -390,6 +394,20 @@ sub webguiBirthday {
|
||||||
return 997966800 ;
|
return 997966800 ;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#----------------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 webguiBirthday ( )
|
||||||
|
|
||||||
|
This constant is used in several tests, so it's reproduced here so it can
|
||||||
|
be found easy. This is the epoch date when WebGUI was released.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub webguiBirthday {
|
||||||
|
return 997966800 ;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
#----------------------------------------------------------------------------
|
#----------------------------------------------------------------------------
|
||||||
|
|
@ -461,6 +479,21 @@ sub sessionsToDelete {
|
||||||
|
|
||||||
#----------------------------------------------------------------------------
|
#----------------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 tagsToRollback ( $tag )
|
||||||
|
|
||||||
|
Push a list of version tags to rollback at the end of the test.
|
||||||
|
|
||||||
|
This is a class method.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub tagsToRollback {
|
||||||
|
my $class = shift;
|
||||||
|
push @tagsToRollback, @_;
|
||||||
|
}
|
||||||
|
|
||||||
|
#----------------------------------------------------------------------------
|
||||||
|
|
||||||
=head2 usersToDelete ( $user, [$user, ...] )
|
=head2 usersToDelete ( $user, [$user, ...] )
|
||||||
|
|
||||||
Push a list of user objects onto the stack of groups to be automatically deleted
|
Push a list of user objects onto the stack of groups to be automatically deleted
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue