oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

adding FilePump

Browse source
This commit is contained in:
Colin Kuskie 2009-05-18 16:03:50 +00:00
commit d8a1623ea0
14 changed files with 1986 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

2
docs/changelog/7.x.x.txt
View file

@ -10,6 +10,8 @@
- added Google Maps asset
- added a way for authors to prevent debugging output on page requests
- 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
- Added mobile style template. If enabled in settings, will serve alternate style templates

47
docs/upgrades/upgrade_7.7.6-7.7.7.pl
View file

@ -22,7 +22,7 @@ use Getopt::Long;
use WebGUI::Session;
use WebGUI::Storage;
use WebGUI::Asset;
use WebGUI::FilePump::Bundle;
my $toVersion = '7.7.7';
my $quiet; # this line required
@ -36,6 +36,9 @@ addRedirectAfterLoginUrlToSettings( $session );
addSurveyTestResultsTemplateColumn( $session );
fixSMSUserProfileI18N($session);
addMapAsset( $session );
installFilePumpHandler($session);
installFilePumpTable($session);
installFilePumpAdminGroup($session);
finish($session); # this line required
@ -107,6 +110,48 @@ sub addSurveyTestResultsTemplateColumn {
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
sub addMapAsset {

8
etc/WebGUI.conf.original
View file

@ -402,6 +402,13 @@
"url" : "^PageUrl(\"\",op=manageCache);",
"title" : "^International(manage cache,WebGUI);",
"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",
"Extras" : "Extras",
"FetchMimeType" : "FetchMimeType",
"FilePump" : "FilePump",
"FileUrl" : "FileUrl",
"GroupAdd" : "GroupAdd",
"GroupDelete" : "GroupDelete",

52
lib/WebGUI/Content/FilePump.pm Normal file
View 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
View 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>&nbsp;</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}) : '&nbsp;'
;
}
$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>&nbsp;</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
View 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
View 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

1
lib/WebGUI/Operation/Settings.pm
View file

@ -514,6 +514,7 @@ sub definition {
groupIdAdminCache
groupIdAdminCron
groupIdAdminDatabaseLink
groupIdAdminFilePump
groupIdAdminGraphics
groupIdAdminGroup
groupIdAdminGroupAdmin

100
lib/WebGUI/i18n/English/FilePump.pm Normal file
View 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

9
lib/WebGUI/i18n/English/WebGUI.pm
View file

@ -3818,6 +3818,15 @@ LongTruncOk=1</p>
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' => {
message => q{Groups (limited)},

2
sbin/testEnvironment.pl
View file

@ -131,6 +131,8 @@ checkModule('Business::Tax::VAT::Validation', '0.20' );
checkModule('Crypt::SSLeay', '0.57' );
checkModule('Scope::Guard', '0.03' );
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;

366
t/FilePump/Bundle.t Normal file
View 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
View 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

33
t/lib/WebGUI/Test.pm
View file

@ -56,6 +56,7 @@ my @groupsToDelete;
my @usersToDelete;
my @sessionsToDelete;
my @storagesToDelete;
my @tagsToRollback;
BEGIN {
@ -164,6 +165,9 @@ END {
$session->var->end;
$session->close;
}
foreach my $tag (@tagsToRollback) {
$tag->rollback;
}
if ($ENV{WEBGUI_TEST_DEBUG}) {
$Test->diag('Sessions: '.$SESSION->db->quickScalar('select count(*) from userSession'));
$Test->diag('Scratch : '.$SESSION->db->quickScalar('select count(*) from userSessionScratch'));
@ -390,6 +394,20 @@ sub webguiBirthday {
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, ...] )
Push a list of user objects onto the stack of groups to be automatically deleted