diff --git a/docs/changelog/7.x.x.txt b/docs/changelog/7.x.x.txt
index 32e79442b..f0732a868 100644
--- a/docs/changelog/7.x.x.txt
+++ b/docs/changelog/7.x.x.txt
@@ -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
diff --git a/docs/upgrades/upgrade_7.7.6-7.7.7.pl b/docs/upgrades/upgrade_7.7.6-7.7.7.pl
index 057779115..929304d6f 100644
--- a/docs/upgrades/upgrade_7.7.6-7.7.7.pl
+++ b/docs/upgrades/upgrade_7.7.6-7.7.7.pl
@@ -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 {
diff --git a/etc/WebGUI.conf.original b/etc/WebGUI.conf.original
index 7bbcdb2af..1b7d0c796 100644
--- a/etc/WebGUI.conf.original
+++ b/etc/WebGUI.conf.original
@@ -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",
diff --git a/lib/WebGUI/Content/FilePump.pm b/lib/WebGUI/Content/FilePump.pm
new file mode 100644
index 000000000..5964bfef0
--- /dev/null
+++ b/lib/WebGUI/Content/FilePump.pm
@@ -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;
diff --git a/lib/WebGUI/FilePump/Admin.pm b/lib/WebGUI/FilePump/Admin.pm
new file mode 100644
index 000000000..de90f2adf
--- /dev/null
+++ b/lib/WebGUI/FilePump/Admin.pm
@@ -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|$error
\n|;
+ }
+ my $tableStub = <%s
+
+%s
+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 '| %s | %s | %s |
',
+ $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| (%s)|,
+ $url->gateway($url->getRequestedUrl,'op=filePump;func=buildBundle;bundleId='.$bundle->getId),
+ $i18n->get('build');
+ }
+ $rows .= sprintf '| %s | %s | %s | %s | ',
+ $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 <get('bundle name'), $i18n->get('last modified'), $i18n->get('last build'), $rows;
+
+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;
diff --git a/lib/WebGUI/FilePump/Bundle.pm b/lib/WebGUI/FilePump/Bundle.pm
new file mode 100644
index 000000000..456fc7f8c
--- /dev/null
+++ b/lib/WebGUI/FilePump/Bundle.pm
@@ -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;
diff --git a/lib/WebGUI/Macro/FilePump.pm b/lib/WebGUI/Macro/FilePump.pm
new file mode 100644
index 000000000..6e3fc584c
--- /dev/null
+++ b/lib/WebGUI/Macro/FilePump.pm
@@ -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|