Allow storage locations to have subdirectories, just to support the ZipArchive.

This commit is contained in:
Colin Kuskie 2009-07-21 21:44:31 +00:00
parent 6dea4f642a
commit 0af4acdfad
3 changed files with 234 additions and 56 deletions

View file

@ -23,6 +23,7 @@
- fixed #10684: i18n Asset_StoryTopic::deleteIcon
- fixed #10685: i18n Asset_StoryTopic::rssUrl
- fixed #10686: Can't access Database Links
- fixed #10650: Unflatten WebGUI storage locations
7.7.15
- fixed #10629: WebGUI::ProfileField create new field bug

View file

@ -23,6 +23,7 @@ use File::Find ();
use File::Path ();
use File::Spec;
use Image::Magick;
use Path::Class::Dir;
use Storable ();
use WebGUI::Utility qw(isIn);
@ -204,12 +205,16 @@ sub _makePath {
#-------------------------------------------------------------------
=head2 _changeOwner ( )
=head2 _changeOwner ( $file )
Changes the owner to be the same as that of the uploads directory
Changes the permissions of $file to be the same as that of the uploads directory
NOTE: This is a private method and should never be called except internally to this package.
=head3 $file
A file or directory. It will have its permissions changed.
=cut
sub _changeOwner {
@ -496,16 +501,30 @@ sub adjustMaxImageSize {
=head2 clear ( )
Clears a storage locations of all files except the .wgaccess file
If configured for CDN, add deletion of this location's files, to CDN queue.
Clears a storage location of all files. If configured for CDN, add
deletion of this location's files, to CDN queue.
=cut
sub clear {
my $self = shift;
my $filelist = $self->getFiles(1);
foreach my $file (@{$filelist}) {
$self->deleteFile($file);
my $dir = $self->getPathClassDir;
my $errors;
CHILD: while (my $child = $dir->next()) {
my $rel = $child->relative($dir);
next CHILD if $rel->stringify eq '.'
|| $rel->stringify eq '..';
if ($child->is_dir) {
my $errors;
$child->rmtree({ error => \$errors});
foreach my $error (@{ $errors }){
$self->_addError($error);
}
}
else {
$child->remove;
next CHILD;
}
}
$self->_cdnDel(1);
}
@ -531,15 +550,24 @@ Optionally pass in the list of filenames to copy from the specified storage loca
sub copy {
my $self = shift;
my $newStorage = shift || WebGUI::Storage->create($self->session);
my $filelist = shift || $self->getFiles(1);
foreach my $file (@{$filelist}) {
next if $file eq '.cdn';
open my $source, '<:raw', $self->getPath($file) or next;
open my $dest, '>:raw', $newStorage->getPath($file) or next;
File::Copy::copy($source, $dest) or $self->_addError("Couldn't copy file ".$self->getPath($file)." to ".$newStorage->getPath($file)." because ".$!);
close $dest;
close $source;
$newStorage->_changeOwner($newStorage->getPath($file));
my $filelist = shift || $self->getFiles('all');
FILE: foreach my $file (@{$filelist}) {
next if isIn($file, '.cdn', '.');
my $origFile = $self->getPath($file);
my $copyFile = $newStorage->getPath($file);
if (-d $origFile) {
mkdir($copyFile) or
$self->_addError("Couldn't copy directory: $copyFile: $!");
next FILE;
}
else {
open my $source, '<:raw', $origFile or next FILE;
open my $dest, '>:raw', $copyFile or next FILE;
File::Copy::copy($source, $dest) or $self->_addError("Couldn't copy file ".$origFile." to ".$copyFile." because ".$!);
close $dest;
close $source;
}
$newStorage->_changeOwner($copyFile);
}
$newStorage->_cdnAdd;
return $newStorage;
@ -636,8 +664,7 @@ sub delete {
my $self = shift;
my $path = $self->getPath || return undef;
File::Path::rmtree($path)
if (-d $path);
File::Path::rmtree($path) if (-d $path);
foreach my $subDir (join('/', @{$self->{_pathParts}}[0,1]), $self->{_pathParts}[0]) {
my $fullPath = $self->session->config->get('uploadsPath') . '/' . $subDir;
@ -654,7 +681,8 @@ sub delete {
=head2 deleteFile ( filename )
Deletes a file from its storage location.
Deletes a file from its storage location, and any thumbnails that might have been made
with it.
=head3 filename
@ -1010,24 +1038,29 @@ Returns an array reference of the files in this storage location.
=head3 showAll
Whether or not to return all files, including ones with initial periods.
Whether or not to return all files, including ones with initial periods and WebGUI created thumbnail
files (files that start with "thumb-").
=cut
sub getFiles {
my $self = shift;
my $self = shift;
my $showAll = shift;
my $dir = $self->getPathClassDir;
my $dirStr = $dir->stringify;
my @list;
if ( opendir my $dir, $self->getPath ) {
@list = readdir $dir;
closedir $dir;
if (!$showAll) {
# if not showing all, filter out files beginning with a period
@list = grep { $_ !~ /^\./ } @list;
# filter out thumbnails
@list = grep { $_ !~ /^thumb-/ } @list;
$dir->recurse(
callback => sub {
my $obj = shift;
my $rel = $obj->relative($dir);
my $str = $rel->stringify;
if (! $showAll ) {
return if $str =~ /^thumb-/;
return if $str =~ /^\./;
}
push @list, $str;
}
}
);
return \@list;
}
@ -1116,6 +1149,28 @@ sub getPath {
}
#-------------------------------------------------------------------
=head2 getPathClassDir ( )
Returns a Path::Class::Dir object for this storage location. If the uploadsPath is not
configured, or the path parts don't exist, then it returns undef.
=cut
sub getPathClassDir {
my $self = shift;
my $file = shift;
unless ($self->session->config->get("uploadsPath") && $self->{_pathParts} && @{ $self->{_pathParts} }) {
$self->_addError("storage object malformed");
return undef;
}
my $dir = Path::Class::Dir->new($self->session->config->get("uploadsPath"), @{ $self->{_pathParts} });
return $dir;
}
#-------------------------------------------------------------------
=head2 getPathFrag ( )
@ -1600,13 +1655,23 @@ sub setPrivileges {
my $owner = shift;
my $viewGroup = shift;
my $editGroup = shift;
if ($owner eq '1' || $viewGroup eq '1' || $viewGroup eq '7' || $editGroup eq '1' || $editGroup eq '7') {
$self->deleteFile('.wgaccess');
}
else {
$self->addFileFromScalar(".wgaccess",$owner."\n".$viewGroup."\n".$editGroup);
}
my $dirObj = $self->getPathClassDir();
$dirObj->recurse(
callback => sub {
my $obj = shift;
return unless $obj->is_dir;
my $rel = $obj->relative($dirObj);
if ($owner eq '1' || $viewGroup eq '1' || $viewGroup eq '7' || $editGroup eq '1' || $editGroup eq '7') {
$self->deleteFile($rel->file('.wgaccess')->stringify);
}
else {
$self->addFileFromScalar($rel->file('.wgaccess')->stringify,$owner."\n".$viewGroup."\n".$editGroup);
}
}
);
}

View file

@ -22,6 +22,7 @@ use Test::More;
use Test::Deep;
use Test::MockObject;
use Cwd;
use Data::Dumper;
my $session = WebGUI::Test->session;
@ -29,7 +30,7 @@ my $cwd = Cwd::cwd();
my ($extensionTests, $fileIconTests) = setupDataDrivenTests($session);
my $numTests = 107; # increment this value for each test you create
my $numTests = 122; # increment this value for each test you create
plan tests => $numTests + scalar @{ $extensionTests } + scalar @{ $fileIconTests };
my $uploadDir = $session->config->get('uploadsPath');
@ -99,6 +100,7 @@ undef $storage1;
$storage1 = WebGUI::Storage->get($session, 'notAGUID');
my $storage2 = WebGUI::Storage->get($session, 'notAGoodId');
WebGUI::Test->storagesToDelete($storage2);
ok(! $storage2->getErrorCount, 'No errors due to a shared common root');
@ -130,6 +132,7 @@ CHECKDIR: while ($dirOpt = pop @dirOptions) {
last CHECKDIR if !-e $dir3;
}
my $storage3 = WebGUI::Storage->get($session, $dirOpt);
WebGUI::Test->storagesToDelete($storage3);
is( $storage3->getErrorCount, 1, 'Error during creation of object due to short GUID');
@ -198,6 +201,31 @@ foreach my $extTest (@{ $extensionTests }) {
is( $storage1->getFileExtension($extTest->{filename}), $extTest->{extension}, $extTest->{comment} );
}
####################################################
#
# getFiles
#
####################################################
my $fileStore = WebGUI::Storage->create($session);
cmp_bag($fileStore->getFiles(1), ['.'], 'Starting with an empty storage object, no files in here except for . ');
$fileStore->addFileFromScalar('.dotfile', 'dot file');
cmp_bag($fileStore->getFiles(), [ ], 'getFiles() by default does not return dot files');
cmp_bag($fileStore->getFiles(1), ['.', '.dotfile'], 'getFiles(1) returns all files, including dot files');
$fileStore->addFileFromScalar('dot.file', 'dot.file');
cmp_bag($fileStore->getFiles(), ['dot.file'], 'getFiles() returns normal files');
cmp_bag($fileStore->getFiles(1), ['.', '.dotfile', 'dot.file'], 'getFiles(1) returns all files, including dot files');
####################################################
#
# getPathClassDir
#
####################################################
my $obj = $storage1->getPathClassDir;
isa_ok($obj, 'Path::Class::Dir');
is($obj->stringify, $storage1->getPath, '... Path::Class::Dir object has correct path');
####################################################
#
# addFileFromHashref
@ -266,9 +294,32 @@ $storage1->copy($secondCopy);
cmp_bag($secondCopy->getFiles(), $storage1->getFiles(), 'copy: passing explicit variable');
my $s3copy = WebGUI::Storage->create($session);
WebGUI::Test->storagesToDelete($s3copy);
my @filesToCopy = qw/WebGUI.pm testfile-hash-renamed.file/;
$storage1->copy($s3copy, [@filesToCopy]);
cmp_bag($s3copy->getFiles(), [ @filesToCopy ], 'copy: passing explicit variable and files to copy');
{
my $deepStorage = WebGUI::Storage->create($session);
WebGUI::Test->storagesToDelete($deepStorage);
my $deepDir = $deepStorage->getPathClassDir();
my $deepDeepDir = $deepDir->subdir('deep');
my $errorStr;
$deepDeepDir->mkpath(1, undef, { error => \$errorStr } );
$deepStorage->addFileFromScalar('deep/file', 'deep file');
cmp_bag(
$deepStorage->getFiles('all'),
[ '.', 'deep', 'deep/file' ],
'... storage setup for deep clear test'
);
my $deepCopy = $deepStorage->copy();
WebGUI::Test->storagesToDelete($deepCopy);
cmp_bag(
$deepCopy->getFiles('all'),
[ '.', 'deep', 'deep/file' ],
'... all files copied, deeply'
);
}
####################################################
#
@ -284,6 +335,7 @@ cmp_bag($storage1->getFiles, [$filename], 'deleteFile: storage1 has only 1 file'
##Test for out of object file deletion
my $hackedStore = WebGUI::Storage->create($session);
WebGUI::Test->storagesToDelete($hackedStore);
$hackedStore->addFileFromScalar('fileToHack', 'Can this file be deleted from another object?');
ok(-e $hackedStore->getPath('fileToHack'), 'set up a file for deleteFile to try and delete illegally');
my $hackedPath = '../../../'.$hackedStore->getPathFrag().'/fileToHack';
@ -337,23 +389,50 @@ isnt($untarStorage->getPath, $tarStorage->getPath, 'untar did not reuse the same
ok(scalar @{ $copiedStorage->getFiles } > 0, 'copiedStorage has some files');
$copiedStorage->clear;
cmp_ok(scalar @{ $copiedStorage->getFiles }, '==', 0, 'clear removed all files from copiedStorage');
cmp_ok(scalar @{ $copiedStorage->getFiles(1) }, '==', 2, 'clear removed _all_ files from copiedStorage, except for . and ..');
cmp_bag(
$copiedStorage->getFiles('all'),
[ '.' ],
'clear removed all files from copiedStorage'
);
cmp_bag(
$copiedStorage->getFiles('all'),
[ '.' ],
'... removed _all_ files from copiedStorage, except for . and ..'
);
####################################################
#
# getFiles
#
####################################################
$copiedStorage->setPrivileges(3,3,3);
cmp_bag(
$copiedStorage->getFiles('all'),
[ '.', '.wgaccess' ],
'... removed _all_ files from copiedStorage, except for . and ..'
);
$copiedStorage->clear;
cmp_bag(
$copiedStorage->getFiles('all'),
[ '.' ],
'... removed .wgaccess file'
);
my $fileStore = WebGUI::Storage->create($session);
cmp_bag($fileStore->getFiles(1), ['.', '..'], 'Starting with an empty storage object, no files in here except for . and ..');
$fileStore->addFileFromScalar('.dotfile', 'dot file');
cmp_bag($fileStore->getFiles(), [ ], 'getFiles() by default does not return dot files');
cmp_bag($fileStore->getFiles(1), ['.', '..', '.dotfile'], 'getFiles(1) returns all files, including dot files');
$fileStore->addFileFromScalar('dot.file', 'dot.file');
cmp_bag($fileStore->getFiles(), ['dot.file'], 'getFiles() returns normal files');
cmp_bag($fileStore->getFiles(1), ['.', '..', '.dotfile', 'dot.file'], 'getFiles(1) returns all files, including dot files');
{
my $deepStorage = WebGUI::Storage->create($session);
WebGUI::Test->storagesToDelete($deepStorage);
my $deepDir = $deepStorage->getPathClassDir();
my $deepDeepDir = $deepDir->subdir('deep');
my $errorStr;
$deepDeepDir->mkpath(1, undef, { error => \$errorStr } );
$deepStorage->addFileFromScalar('deep/file', 'deep file');
cmp_bag(
$deepStorage->getFiles('all'),
[ '.', 'deep', 'deep/file' ],
'... storage setup for deep clear test'
);
$deepStorage->clear();
cmp_bag(
$deepStorage->getFiles('all'),
[ '.', ],
'... clear removes directories'
);
}
####################################################
#
@ -384,6 +463,39 @@ foreach my $iconTest (@{ $fileIconTests }) {
is( $storage1->getFileIconUrl($iconTest->{filename}), $iconTest->{iconUrl}, $iconTest->{comment} );
}
####################################################
#
# setPrivileges
#
####################################################
my $shallowStorage = WebGUI::Storage->create($session);
WebGUI::Test->storagesToDelete($shallowStorage);
$shallowStorage->setPrivileges(3,3,3);
my $shallowDir = $shallowStorage->getPathClassDir();
ok(-e $shallowDir->file('.wgaccess')->stringify, 'setPrivilege: .wgaccess file created in shallow storage');
my $privs;
$privs = $shallowStorage->getFileContentsAsScalar('.wgaccess');
is ($privs, "3\n3\n3", '... correct group contents');
$shallowStorage->deleteFile('.wgaccess');
my $deepStorage = WebGUI::Storage->create($session);
WebGUI::Test->storagesToDelete($deepStorage);
my $deepDir = $deepStorage->getPathClassDir();
my $deepDeepDir = $deepDir->subdir('deep');
my $errorStr;
$deepDeepDir->mkpath(1, undef, { error => \$errorStr } );
ok(-e $deepDeepDir->stringify, 'created storage directory with a subdirectory for testing');
$deepStorage->setPrivileges(3,3,3);
ok(-e $deepDir->file('.wgaccess')->stringify, '.wgaccess file created in deep storage');
ok(-e $deepDeepDir->file('.wgaccess')->stringify, '.wgaccess file created in deep storage subdir');
$privs = $deepStorage->getFileContentsAsScalar('.wgaccess');
is ($privs, "3\n3\n3", '... correct group contents, deep storage');
$privs = $deepStorage->getFileContentsAsScalar('deep/.wgaccess');
is ($privs, "3\n3\n3", '... correct group contents, deep storage subdir');
####################################################
#
# CDN (Content Delivery Network)
@ -575,10 +687,10 @@ sub setupDataDrivenTests {
END {
foreach my $stor (
$storage1, $storage2, $storage3, $copiedStorage,
$secondCopy, $s3copy, $tempStor, $tarStorage,
$storage1, $copiedStorage,
$secondCopy, $tempStor, $tarStorage,
$untarStorage, $fileStore,
$hackedStore, $cdnStorage, $cdnCopy,
$cdnStorage, $cdnCopy,
) {
ref $stor eq "WebGUI::Storage" and $stor->delete;
}