improved performance of file uploads and changed format of created uploads locations, avoiding case sensitivity problems
This commit is contained in:
Graham Knop
parent
6c0688add2
commit
d6e00cab05
8 changed files with 193 additions and 271 deletions
|
|
@ -1,4 +1,6 @@
|
|||
7.6.3
|
||||
- improved performance of file uploads
|
||||
- changed format of created uploads locations, avoiding case sensitivity problems
|
||||
- fixed #8989: Missing profile field "showOnline" for the UsersOnline macro.
|
||||
- Added DataTable to WebGUI.conf.original
|
||||
- Added a better mechanism for calculating when content was last modified for
|
||||
|
|
|
|||
|
|
@ -32,11 +32,21 @@ my $session = start(); # this line required
|
|||
createLastUpdatedField($session);
|
||||
createFieldShowOnline($session);
|
||||
upgradeSyndicatedContentTemplates($session);
|
||||
removeCaseInsensitiveConfig($session);
|
||||
migrateSurvey($session);
|
||||
|
||||
finish($session); # this line required
|
||||
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# removes the caseInsensitiveOS flag from the config file, as it isn't used anymore
|
||||
sub removeCaseInsensitiveConfig {
|
||||
my $session = shift;
|
||||
print "\tRemoving caseInsensitiveOS flag from config..." unless $quiet;
|
||||
$session->config->delete('caseInsensitiveOS');
|
||||
$session->db->write('DROP TABLE storageTranslation');
|
||||
print " Done.\n" unless $quiet;
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# This method migrates the the old survey system and existing surveys to the new survey system
|
||||
|
|
@ -87,7 +97,7 @@ sub migrateSurvey{
|
|||
}
|
||||
|
||||
#move over questions
|
||||
my %qMap = ('radioList','Multiple Choice','text','Text','HTMLArea','Text','textArea','Text');
|
||||
#my %qMap = ('radioList','Multiple Choice','text','Text','HTMLArea','Text','textArea','Text');
|
||||
$sql = "select * from Survey_question_old where Survey_id = '$$survey{Survey_id}' order by sequenceNumber";
|
||||
my $questions = $session->db->buildArrayRefOfHashRefs($sql);
|
||||
my $qId = 0;
|
||||
|
|
|
|||
|
|
@ -51,11 +51,6 @@
|
|||
|
||||
"gateway" : "/",
|
||||
|
||||
# Enable this flag if you run or back up files on a case sensitive
|
||||
# file system. This will ensure uniqueness in the uploads folder
|
||||
|
||||
#"caseInsensitiveOS" : "1",
|
||||
|
||||
# The relative or fully qualified URL to the extras folder
|
||||
# that comes with WebGUI.
|
||||
|
||||
|
|
|
|||
|
|
@ -162,8 +162,7 @@ sub getRedirectLocation {
|
|||
=head2 getStatus ( ) {
|
||||
|
||||
Returns the current HTTP status code. If no code has been set,
|
||||
the code returned will be 200. If no description has been set,
|
||||
the internal description will be set to "OK" and "OK" will be returned.
|
||||
the code returned will be 200.
|
||||
|
||||
=cut
|
||||
|
||||
|
|
|
|||
|
|
@ -14,17 +14,17 @@ package WebGUI::Storage;
|
|||
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Archive::Tar;
|
||||
use Carp qw( croak );
|
||||
use Cwd ();
|
||||
use File::Copy qw(cp);
|
||||
use FileHandle;
|
||||
use File::Find;
|
||||
use File::Path;
|
||||
use Storable qw(nstore retrieve);
|
||||
use strict;
|
||||
use warnings;
|
||||
use WebGUI::Utility;
|
||||
use File::Copy ();
|
||||
use File::Find ();
|
||||
use File::Path ();
|
||||
use File::Spec;
|
||||
use Storable ();
|
||||
use WebGUI::Utility qw(isIn);
|
||||
|
||||
=head1 NAME
|
||||
|
||||
|
|
@ -112,7 +112,7 @@ NOTE: This is a private method and should never be called except internally to t
|
|||
sub _makePath {
|
||||
my $self = shift;
|
||||
my $node = $self->session->config->get("uploadsPath");
|
||||
foreach my $folder ($self->{_part1}, $self->{_part2}, $self->getFileId) {
|
||||
foreach my $folder (@{ $self->{_pathParts} }) {
|
||||
$node .= '/'.$folder;
|
||||
unless (-e $node) { # check to see if it already exists
|
||||
if (mkdir($node)) { # check to see if there was an error during creation
|
||||
|
|
@ -158,46 +158,43 @@ Provide the local path to this file.
|
|||
=cut
|
||||
|
||||
sub addFileFromFilesystem {
|
||||
my $self = shift;
|
||||
my $pathToFile = shift;
|
||||
my $filename;
|
||||
if (defined $pathToFile) {
|
||||
if ($pathToFile =~ /([^\/\\]+)$/) {
|
||||
$filename = $1;
|
||||
} else {
|
||||
$pathToFile = $filename;
|
||||
}
|
||||
if (isIn($self->getFileExtension, qw(pl perl sh cgi php asp))) {
|
||||
$filename =~ s/\./\_/g;
|
||||
$filename .= ".txt";
|
||||
}
|
||||
$filename = $self->session->url->makeCompliant($filename);
|
||||
if (-d $pathToFile) {
|
||||
$self->session->errorHandler->error($pathToFile." is a directory, not a file.");
|
||||
} else {
|
||||
my $source = FileHandle->new($pathToFile,"r");
|
||||
if (defined $source) {
|
||||
binmode($source);
|
||||
my $dest = FileHandle->new(">".$self->getPath($filename));
|
||||
if (defined $dest) {
|
||||
binmode($dest);
|
||||
cp($source,$dest) or $self->_addError("Couldn't copy $pathToFile to ".$self->getPath($filename).": $!");
|
||||
$dest->close;
|
||||
$self->_changeOwner($self->getPath($filename));
|
||||
} else {
|
||||
$self->_addError("Couldn't open file ".$self->getPath($filename)." for writing due to error: ".$!);
|
||||
$filename = undef;
|
||||
}
|
||||
$source->close;
|
||||
} else {
|
||||
$self->_addError("Couldn't open file ".$pathToFile." for reading due to error: ".$!);
|
||||
$filename = undef;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
$filename = undef;
|
||||
}
|
||||
return $filename;
|
||||
my $self = shift;
|
||||
my $pathToFile = shift;
|
||||
if (! defined $pathToFile) {
|
||||
return undef;
|
||||
}
|
||||
$pathToFile = Cwd::realpath($pathToFile); # trace any symbolic links
|
||||
if (-d $pathToFile) {
|
||||
$self->session->log->error($pathToFile." is a directory, not a file.");
|
||||
return undef;
|
||||
}
|
||||
# checks the same file
|
||||
elsif (!-f _) {
|
||||
$self->session->log->error($pathToFile." is not a regular file.");
|
||||
return undef;
|
||||
}
|
||||
my $filename = (File::Spec->splitpath( $pathToFile ))[2];
|
||||
if (isIn($self->getFileExtension($filename), qw(pl perl sh cgi php asp))) {
|
||||
$filename =~ s/\./\_/g;
|
||||
$filename .= ".txt";
|
||||
}
|
||||
$filename = $self->session->url->makeCompliant($filename);
|
||||
my $source;
|
||||
my $dest;
|
||||
unless ( open $source, '<:raw', $pathToFile ) {
|
||||
$self->_addError("Couldn't open file ".$pathToFile." for reading due to error: ".$!);
|
||||
return undef;
|
||||
}
|
||||
unless ( open $dest, '>:raw', $self->getPath($filename) ) {
|
||||
$self->_addError("Couldn't open file ".$self->getPath($filename)." for writing due to error: ".$!);
|
||||
close $source;
|
||||
return undef;
|
||||
}
|
||||
File::Copy::copy($source,$dest)
|
||||
or $self->_addError("Couldn't copy $pathToFile to ".$self->getPath($filename).": $!");
|
||||
close $dest;
|
||||
close $source;
|
||||
return $filename;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -221,45 +218,43 @@ sub addFileFromFormPost {
|
|||
my $self = shift;
|
||||
my $formVariableName = shift;
|
||||
my $attachmentLimit = shift || 99999;
|
||||
return "" if ($self->session->http->getStatus() =~ /^413/);
|
||||
require Apache2::Request;
|
||||
my $session = $self->session;
|
||||
return ""
|
||||
if ($self->session->http->getStatus eq '413');
|
||||
require Apache2::Request;
|
||||
require Apache2::Upload;
|
||||
my $filename;
|
||||
my $attachmentCount = 1;
|
||||
foreach my $upload ($self->session->request->upload($formVariableName)) {
|
||||
$self->session->errorHandler->info("Trying to get " . $upload->filename);
|
||||
return $filename if $attachmentCount > $attachmentLimit;
|
||||
my $tempFilename = $upload->filename();
|
||||
next unless $tempFilename;
|
||||
next unless $upload->size > 0;
|
||||
next if ($upload->size > 1024 * $self->session->setting->get("maxAttachmentSize"));
|
||||
if ($tempFilename =~ /([^\/\\]+)$/) { $tempFilename = $1; }
|
||||
my $type = $self->getFileExtension($tempFilename);
|
||||
if (isIn($type, qw(pl perl sh cgi php asp html htm))) { # make us safe from malicious uploads
|
||||
$tempFilename =~ s/\./\_/g;
|
||||
$tempFilename .= ".txt";
|
||||
}
|
||||
$filename = $self->session->url->makeCompliant($tempFilename);
|
||||
my $bytesread;
|
||||
my $file = FileHandle->new(">".$self->getPath($filename));
|
||||
$attachmentCount++;
|
||||
if (defined $file) {
|
||||
my $buffer;
|
||||
my $sourcefh = $upload->fh;
|
||||
binmode $file;
|
||||
while ($bytesread=read($sourcefh,$buffer,1024)) {
|
||||
print $file $buffer;
|
||||
}
|
||||
close($file);
|
||||
$self->_changeOwner($self->getPath($filename));
|
||||
$self->session->errorHandler->info("Got ".$upload->filename);
|
||||
} else {
|
||||
$self->_addError("Couldn't open file ".$self->getPath($filename)." for writing due to error: ".$!);
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
return $filename if $filename;
|
||||
return undef;
|
||||
my $filename;
|
||||
my $attachmentCount = 1;
|
||||
foreach my $upload ($session->request->upload($formVariableName)) {
|
||||
$session->errorHandler->info("Trying to get " . $upload->filename);
|
||||
return $filename
|
||||
if $attachmentCount > $attachmentLimit;
|
||||
my $clientFilename = $upload->filename;
|
||||
next
|
||||
unless $clientFilename;
|
||||
next
|
||||
unless $upload->size > 0;
|
||||
next
|
||||
if ($upload->size > 1024 * $self->session->setting->get("maxAttachmentSize"));
|
||||
$clientFilename =~ s/.*[\/\\]//;
|
||||
my $type = $self->getFileExtension($clientFilename);
|
||||
if (isIn($type, qw(pl perl sh cgi php asp html htm))) { # make us safe from malicious uploads
|
||||
$clientFilename =~ s/\./\_/g;
|
||||
$clientFilename .= ".txt";
|
||||
}
|
||||
$filename = $session->url->makeCompliant($clientFilename);
|
||||
my $filePath = $self->getPath($filename);
|
||||
$attachmentCount++;
|
||||
if ($upload->link($filePath)) {
|
||||
$self->_changeOwner($filePath);
|
||||
$self->session->errorHandler->info("Got ".$upload->filename);
|
||||
}
|
||||
else {
|
||||
$self->_addError("Couldn't open file ".$self->getPath($filename)." for writing due to error: ".$!);
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
return $filename;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -283,7 +278,8 @@ sub addFileFromHashref {
|
|||
my $self = shift;
|
||||
my $filename = $self->session->url->makeCompliant(shift);
|
||||
my $hashref = shift;
|
||||
nstore $hashref, $self->getPath($filename) or $self->_addError("Couldn't create file ".$self->getPath($filename)." because ".$!);
|
||||
Storable::nstore($hashref, $self->getPath($filename))
|
||||
or $self->_addError("Couldn't create file ".$self->getPath($filename)." because ".$!);
|
||||
$self->_changeOwner($self->getPath($filename));
|
||||
return $filename;
|
||||
}
|
||||
|
|
@ -308,12 +304,13 @@ sub addFileFromScalar {
|
|||
my $self = shift;
|
||||
my $filename = $self->session->url->makeCompliant(shift);
|
||||
my $content = shift;
|
||||
if (open(my $FILE,">",$self->getPath($filename))) {
|
||||
if (open(my $FILE, ">", $self->getPath($filename))) {
|
||||
print $FILE $content;
|
||||
close($FILE);
|
||||
$self->_changeOwner($self->getPath($filename));
|
||||
} else {
|
||||
$self->_addError("Couldn't create file ".$self->getPath($filename)." because ".$!);
|
||||
}
|
||||
else {
|
||||
$self->_addError("Couldn't create file ".$self->getPath($filename)." because ".$!);
|
||||
}
|
||||
return $filename;
|
||||
}
|
||||
|
|
@ -329,8 +326,8 @@ Clears a storage locations of all files except the .wgaccess file
|
|||
sub clear {
|
||||
my $self = shift;
|
||||
my $filelist = $self->getFiles(1);
|
||||
foreach my $file (@{$filelist}) {
|
||||
$self->deleteFile($file);
|
||||
foreach my $file (@{$filelist}) {
|
||||
$self->deleteFile($file);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -356,11 +353,9 @@ sub copy {
|
|||
my $newStorage = shift || WebGUI::Storage->create($self->session);
|
||||
my $filelist = shift || $self->getFiles(1);
|
||||
foreach my $file (@{$filelist}) {
|
||||
open my $source, '<', $self->getPath($file) or next;
|
||||
open my $dest, '>', $newStorage->getPath($file) or next;
|
||||
binmode $source;
|
||||
binmode $dest;
|
||||
cp($source, $dest) or $self->_addError("Couldn't copy file ".$self->getPath($file)." to ".$newStorage->getPath($file)." because ".$!);
|
||||
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));
|
||||
|
|
@ -387,7 +382,7 @@ sub copyFile {
|
|||
croak "Second argument must be a filename"
|
||||
unless $newFilename;
|
||||
|
||||
cp( $self->getPath($filename), $self->getPath($newFilename) )
|
||||
File::Copy::copy( $self->getPath($filename), $self->getPath($newFilename) )
|
||||
|| croak "Couldn't copy '$filename' to '$newFilename': $!";
|
||||
$self->_changeOwner($self->getPath($filename));
|
||||
|
||||
|
|
@ -409,19 +404,8 @@ A reference to the current session;
|
|||
sub create {
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
my $id = $session->id->generate();
|
||||
|
||||
#Determine whether or not to use case insensitive files
|
||||
my $config = $session->config;
|
||||
my $db = $session->db;
|
||||
my $caseInsensitive = $config->get("caseInsensitiveOS");
|
||||
|
||||
#For case insensitive operating systems, convert guid to hex
|
||||
if ($caseInsensitive) {
|
||||
my $hexId = $session->id->toHex($id);
|
||||
$db->write("insert into storageTranslation (guidValue,hexValue) values (?,?)",[$id,$hexId]);
|
||||
}
|
||||
|
||||
my $id = $session->id->generate;
|
||||
|
||||
my $self = $class->get($session,$id);
|
||||
$self->_makePath;
|
||||
|
||||
|
|
@ -445,23 +429,11 @@ A reference to the current session.
|
|||
sub createTemp {
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
my $id = $session->id->generate();
|
||||
my $guid = $id;
|
||||
my $id = $session->id->generate;
|
||||
my $path = $session->id->toHex($id);
|
||||
|
||||
#Determine whether or not to use case insensitive files
|
||||
my $config = $session->config;
|
||||
my $db = $session->db;
|
||||
my $caseInsensitive = $config->get("caseInsensitiveOS");
|
||||
|
||||
#For case insensitive operating systems, convert guid to hex
|
||||
if($caseInsensitive) {
|
||||
my $hexId = $session->id->toHex($id);
|
||||
$db->write("insert into storageTranslation (guidValue,hexValue) values (?,?)",[$id,$hexId]);
|
||||
$id = $hexId;
|
||||
}
|
||||
|
||||
$id =~ m/^(.{2})/;
|
||||
my $self = {_session=>$session, _id => $guid, _part1 => 'temp', _part2 => $1, _errors => []};
|
||||
$path =~ m/^(.{2})/;
|
||||
my $self = {_session=>$session, _id => $id, _pathParts => ['temp', $1, $path], _errors => []};
|
||||
bless $self, ref($class)||$class;
|
||||
$self->_makePath;
|
||||
return $self;
|
||||
|
|
@ -477,30 +449,18 @@ Deletes this storage location and its contents (if any) from the filesystem.
|
|||
|
||||
sub delete {
|
||||
my $self = shift;
|
||||
my $db = $self->session->db;
|
||||
|
||||
my $path = $self->getPath;
|
||||
if ($path) {
|
||||
rmtree($path) if (-d $path);
|
||||
foreach my $subDir ($self->{_part1}.'/'.$self->{_part2}, $self->{_part1}) {
|
||||
my $uDir = $self->session->config->get('uploadsPath') . '/' . $subDir;
|
||||
if (opendir my $DH, $uDir) {
|
||||
my @dirs = grep { !/^\.+$/ } readdir($DH);
|
||||
if (scalar @dirs == 0) {
|
||||
rmtree($uDir);
|
||||
}
|
||||
close $DH;
|
||||
} else {
|
||||
$self->session->errorHandler->warn("Unable to open $uDir for directory reading");
|
||||
}
|
||||
}
|
||||
#Delete the item from the storageTranslation table
|
||||
if($self->session->config->get("caseInsensitiveOS")){
|
||||
$db->write("delete from storageTranslation where guidValue=?",[$self->getId]);
|
||||
}
|
||||
}
|
||||
$self->session->errorHandler->info("Deleted storage ".$self->getId);
|
||||
return undef;
|
||||
|
||||
my $path = $self->getPath || return undef;
|
||||
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;
|
||||
|
||||
# can only remove empty directories, will fail silently otherwise
|
||||
rmdir $fullPath;
|
||||
}
|
||||
$self->session->errorHandler->info("Deleted storage ".$self->getId);
|
||||
return undef;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
|
@ -519,7 +479,8 @@ it doesn't.
|
|||
sub deleteFile {
|
||||
my $self = shift;
|
||||
my $filename = shift;
|
||||
return undef if $filename =~ m{\.\./}; ##prevent deleting files outside of this object
|
||||
return undef
|
||||
if $filename =~ m{\.\./}; ##prevent deleting files outside of this object
|
||||
unlink($self->getPath($filename));
|
||||
}
|
||||
|
||||
|
|
@ -541,39 +502,29 @@ The unique identifier for this file system storage location.
|
|||
=cut
|
||||
|
||||
sub get {
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
my $id = shift;
|
||||
return undef unless $id;
|
||||
my $guid = $id;
|
||||
my $self;
|
||||
|
||||
my $db = $session->db;
|
||||
|
||||
#Determine whether or not to use case insensitive files
|
||||
my $config = $session->config;
|
||||
my $caseInsensitive = $config->get("caseInsensitiveOS");
|
||||
my $class = shift;
|
||||
$class = ref($class) || $class;
|
||||
my $session = shift;
|
||||
my $id = shift;
|
||||
return undef
|
||||
unless $id;
|
||||
my $self = bless {_session=>$session, _id => $id, _errors => []}, $class;
|
||||
|
||||
#For case insensitive operating systems, convert guid to hex
|
||||
if($caseInsensitive) {
|
||||
#Determine if the item is in the database
|
||||
my ($hexId) = $db->quickArray("select hexValue from storageTranslation where guidValue=?",[$id]);
|
||||
|
||||
#Set the value of the guid to the hex value if found.
|
||||
$id = $hexId if($hexId);
|
||||
my $uploadsRoot = $session->config->get('uploadsPath');
|
||||
my @parts = ($id =~ m/^((.{2})(.{2}).+)/)[1,2,0];
|
||||
unless (@parts) {
|
||||
$self->_addError("Illegal ID: $id");
|
||||
return $self;
|
||||
}
|
||||
|
||||
$self = {_session=>$session, _id => $guid, _errors => []};
|
||||
bless $self, ref($class)||$class;
|
||||
if (my ($part1, $part2) = $id =~ m/^(.{2})(.{2})/) {
|
||||
$self->{_part1} = $part1;
|
||||
$self->{_part2} = $part2;
|
||||
$self->_makePath unless (-e $self->getPath); # create the folder in case it got deleted somehow
|
||||
}
|
||||
else {
|
||||
$self->_addError("Illegal ID: $id");
|
||||
}
|
||||
return $self;
|
||||
if (!-e join('/', $uploadsRoot, @parts)) {
|
||||
my $hexId = $session->id->toHex($id);
|
||||
@parts = ($hexId =~ m/^((.{2})(.{2}).+)/)[1,2,0];
|
||||
}
|
||||
$self->{_pathParts} = \@parts;
|
||||
# create the folder in case it got deleted somehow
|
||||
$self->_makePath
|
||||
unless (-e $self->getPath);
|
||||
return $self;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
|
@ -620,7 +571,7 @@ The file to retrieve the data from.
|
|||
sub getFileContentsAsHashref {
|
||||
my $self = shift;
|
||||
my $filename = shift;
|
||||
return retrieve($self->getPath($filename));
|
||||
return Storable::retrieve($self->getPath($filename));
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -639,11 +590,10 @@ The name of the file to read from.
|
|||
sub getFileContentsAsScalar {
|
||||
my $self = shift;
|
||||
my $filename = shift;
|
||||
my $content;
|
||||
open (my $FILE,"<",$self->getPath($filename));
|
||||
open my $FILE, '<', $self->getPath($filename) or return undef;
|
||||
local $/;
|
||||
$content = <$FILE>;
|
||||
close($FILE);
|
||||
my $content = <$FILE>;
|
||||
close $FILE;
|
||||
return $content;
|
||||
}
|
||||
|
||||
|
|
@ -665,8 +615,8 @@ sub getFileExtension {
|
|||
my $self = shift;
|
||||
my $filename = shift;
|
||||
$filename = lc $filename;
|
||||
my ($extension) = $filename =~ /\.([^.]*)$/;
|
||||
return $extension;
|
||||
my ($extension) = $filename =~ /\.([^.]*)$/;
|
||||
return $extension;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -707,8 +657,7 @@ Returns the size of this file.
|
|||
sub getFileSize {
|
||||
my $self = shift;
|
||||
my $filename = shift;
|
||||
my (@attributes) = stat($self->getPath($filename));
|
||||
return $attributes[7];
|
||||
return (stat($self->getPath($filename)))[7];
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -749,24 +698,7 @@ Returns the file id for this storage location.
|
|||
|
||||
sub getFileId {
|
||||
my $self = shift;
|
||||
my $session = $self->session;
|
||||
my $config = $session->config;
|
||||
my $db = $session->db;
|
||||
|
||||
my $id = $self->getId;
|
||||
|
||||
my $caseInsensitive = $config->get("caseInsensitiveOS");
|
||||
|
||||
#For case insensitive operating systems, convert guid to hex
|
||||
if($caseInsensitive) {
|
||||
#Determine if the item is in the database
|
||||
my ($hexId) = $db->quickArray("select hexValue from storageTranslation where guidValue=?",[$id]);
|
||||
|
||||
#Set the value of the guid to the hex value if found.
|
||||
return $hexId if($hexId);
|
||||
}
|
||||
|
||||
return $id;
|
||||
return $self->getId;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
|
@ -812,19 +744,16 @@ NOTE: Does not check if the file exists. This is a feature.
|
|||
=cut
|
||||
|
||||
sub getPath {
|
||||
my $self = shift;
|
||||
my $self = shift;
|
||||
my $file = shift;
|
||||
my $id = $self->getFileId;
|
||||
|
||||
unless ($self->session->config->get("uploadsPath") && $self->{_part1} && $self->{_part2} && $id) {
|
||||
|
||||
unless ($self->session->config->get("uploadsPath") && $self->{_pathParts} && @{ $self->{_pathParts} }) {
|
||||
$self->_addError("storage object malformed");
|
||||
return undef;
|
||||
}
|
||||
my $path = $self->session->config->get("uploadsPath")
|
||||
. '/'
|
||||
. $self->getPathFrag();
|
||||
}
|
||||
my $path = join('/', $self->session->config->get("uploadsPath"), @{ $self->{_pathParts} });
|
||||
if (defined $file) {
|
||||
$path .= '/'.$file;
|
||||
return join('/', $path, $file);
|
||||
}
|
||||
return $path;
|
||||
}
|
||||
|
|
@ -839,8 +768,8 @@ Returns the internal, upload dir specific part of the path.
|
|||
=cut
|
||||
|
||||
sub getPathFrag {
|
||||
my $self = shift;
|
||||
return join '/', $self->{_part1}, $self->{_part2}, $self->getFileId;
|
||||
my $self = shift;
|
||||
return join '/', @{ $self->{_pathParts} };
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -872,7 +801,7 @@ sub getUrl {
|
|||
|
||||
=head2 renameFile ( filename, newFilename )
|
||||
|
||||
Renames an file's filename. Returns true if the rename succeeded and false
|
||||
Renames a file's filename. Returns true if the rename succeeded and false
|
||||
if it didn't.
|
||||
|
||||
=head3 filename
|
||||
|
|
@ -889,7 +818,7 @@ sub renameFile {
|
|||
my $self = shift;
|
||||
my $filename = shift;
|
||||
my $newFilename = shift;
|
||||
rename $self->getPath($filename), $self->getPath($newFilename);
|
||||
rename $self->getPath($filename), $self->getPath($newFilename);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -964,9 +893,10 @@ sub tar {
|
|||
my $filename = shift;
|
||||
my $temp = shift || WebGUI::Storage->createTemp($self->session);
|
||||
my $originalDir = Cwd::cwd();
|
||||
chdir $self->getPath or croak 'Unable to chdir to ' . $self->getPath . ": $!";
|
||||
my @files = ();
|
||||
find(sub { push(@files, $File::Find::name)}, ".");
|
||||
chdir $self->getPath
|
||||
or croak 'Unable to chdir to ' . $self->getPath . ": $!";
|
||||
my @files;
|
||||
File::Find::find(sub { push(@files, $File::Find::name)}, ".");
|
||||
Archive::Tar->create_archive($temp->getPath($filename),1,@files);
|
||||
chdir $originalDir;
|
||||
return $temp;
|
||||
|
|
@ -998,9 +928,10 @@ sub untar {
|
|||
local $Archive::Tar::CHOWN = 0;
|
||||
local $Archive::Tar::CHMOD = 0;
|
||||
Archive::Tar->extract_archive($self->getPath($filename),1);
|
||||
$self->_addError(Archive::Tar->error) if (Archive::Tar->error);
|
||||
$self->_addError(Archive::Tar->error)
|
||||
if (Archive::Tar->error);
|
||||
my @files;
|
||||
find(sub {
|
||||
File::Find::find(sub {
|
||||
push(@files, $File::Find::name);
|
||||
}, ".");
|
||||
$self->_changeOwner(@files);
|
||||
|
|
@ -1009,5 +940,5 @@ sub untar {
|
|||
return $temp;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
|
|
|
|||
|
|
@ -233,7 +233,7 @@ SKIP: {
|
|||
|
||||
$storage = $taxer->exportTaxData();
|
||||
isa_ok($storage, 'WebGUI::Storage', 'exportTaxData returns a WebGUI::Storage object');
|
||||
is($storage->{_part1}, 'temp', 'The storage object is in the temporary area');
|
||||
is(substr($storage->getPathFrag, 0, 5), 'temp/', 'The storage object is in the temporary area');
|
||||
ok(-e $storage->getPath('siteTaxData.csv'), 'siteTaxData.csv file exists in the storage object');
|
||||
cmp_ok($storage->getFileSize('siteTaxData.csv'), '!=', 0, 'CSV file is not empty');
|
||||
my @fileLines = split /\n+/, $storage->getFileContentsAsScalar('siteTaxData.csv');
|
||||
|
|
|
|||
43
t/Storage.t
43
t/Storage.t
|
|
@ -29,7 +29,7 @@ my $cwd = Cwd::cwd();
|
|||
|
||||
my ($extensionTests, $fileIconTests) = setupDataDrivenTests($session);
|
||||
|
||||
my $numTests = 82; # increment this value for each test you create
|
||||
my $numTests = 75; # increment this value for each test you create
|
||||
plan tests => $numTests + scalar @{ $extensionTests } + scalar @{ $fileIconTests };
|
||||
|
||||
my $uploadDir = $session->config->get('uploadsPath');
|
||||
|
|
@ -68,7 +68,7 @@ is( $storage1->getLastError, undef, "No errors during path creation");
|
|||
#
|
||||
####################################################
|
||||
|
||||
is( $storage1->getPathFrag, 'fo/ob/foobar', 'pathFrag returns correct value');
|
||||
is( $storage1->getPathFrag, '7e/8a/7e8a1b6a', 'pathFrag returns correct value');
|
||||
|
||||
####################################################
|
||||
#
|
||||
|
|
@ -76,15 +76,15 @@ is( $storage1->getPathFrag, 'fo/ob/foobar', 'pathFrag returns correct value');
|
|||
#
|
||||
####################################################
|
||||
|
||||
my $storageDir1 = join '/', $uploadDir, 'fo', 'ob', 'foobar';
|
||||
is ($storageDir1, $storage1->getPath, 'getPath: path calculated correctly for directory');
|
||||
my $storageDir1 = join '/', $uploadDir, '7e', '8a', '7e8a1b6a';
|
||||
is ($storage1->getPath, $storageDir1, 'getPath: path calculated correctly for directory');
|
||||
my $storageFile1 = join '/', $storageDir1, 'baz';
|
||||
is ($storageFile1, $storage1->getPath('baz'), 'getPath: path calculated correctly for file');
|
||||
is ($storage1->getPath('baz'), $storageFile1, 'getPath: path calculated correctly for file');
|
||||
|
||||
my $storageUrl1 = join '/', $uploadUrl, 'fo', 'ob', 'foobar';
|
||||
is ($storageUrl1, $storage1->getUrl, 'getUrl: url calculated correctly for directory');
|
||||
my $storageUrl1 = join '/', $uploadUrl, '7e', '8a', '7e8a1b6a';
|
||||
is ($storage1->getUrl, $storageUrl1, 'getUrl: url calculated correctly for directory');
|
||||
my $storageUrl2 = join '/', $storageUrl1, 'bar';
|
||||
is ($storageUrl2, $storage1->getUrl('bar'), 'getUrl: url calculated correctly for file');
|
||||
is ($storage1->getUrl('bar'), $storageUrl2, 'getUrl: url calculated correctly for file');
|
||||
|
||||
ok( (-e $storageDir1 and -d $storageDir1), "Storage location created and is a directory");
|
||||
|
||||
|
|
@ -290,7 +290,7 @@ ok(-e $hackedStore->getPath('fileToHack'), 'deleteFile did not delete the file i
|
|||
my $tempStor = WebGUI::Storage->createTemp($session);
|
||||
|
||||
isa_ok( $tempStor, "WebGUI::Storage", "createTemp creates WebGUI::Storage object");
|
||||
is ($tempStor->{_part1}, 'temp', 'createTemp puts stuff in the temp directory');
|
||||
is (substr($tempStor->getPathFrag, 0, 5), 'temp/', 'createTemp puts stuff in the temp directory');
|
||||
use Data::Dumper;
|
||||
diag Dumper $tempStor->getErrors();
|
||||
ok (-e $tempStor->getPath(), 'createTemp: directory was created');
|
||||
|
|
@ -303,7 +303,7 @@ ok (-e $tempStor->getPath(), 'createTemp: directory was created');
|
|||
|
||||
my $tarStorage = $copiedStorage->tar('tar.tar');
|
||||
isa_ok( $tarStorage, "WebGUI::Storage", "tar: returns a WebGUI::Storage object");
|
||||
is ($tarStorage->{_part1}, 'temp', 'tar: puts stuff in the temp directory');
|
||||
is (substr($tarStorage->getPathFrag, 0, 5), 'temp/', 'tar: puts stuff in the temp directory');
|
||||
cmp_bag($tarStorage->getFiles(), [ 'tar.tar' ], 'tar: storage contains only the tar file');
|
||||
isnt($tarStorage->getPath, $copiedStorage->getPath, 'tar did not reuse the same path as the source storage object');
|
||||
|
||||
|
|
@ -315,7 +315,7 @@ isnt($tarStorage->getPath, $copiedStorage->getPath, 'tar did not reuse the same
|
|||
|
||||
my $untarStorage = $tarStorage->untar('tar.tar');
|
||||
isa_ok( $untarStorage, "WebGUI::Storage", "untar: returns a WebGUI::Storage object");
|
||||
is ($untarStorage->{_part1}, 'temp', 'untar: puts stuff in the temp directory');
|
||||
is (substr($untarStorage->getPathFrag, 0, 5), 'temp/', 'untar: puts stuff in the temp directory');
|
||||
##Note, getFiles will NOT recurse, so do not use a deep directory structure here
|
||||
cmp_bag($untarStorage->getFiles, $copiedStorage->getFiles, 'tar and untar loop preserve all files');
|
||||
isnt($untarStorage->getPath, $tarStorage->getPath, 'untar did not reuse the same path as the tar storage object');
|
||||
|
|
@ -346,27 +346,6 @@ $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');
|
||||
|
||||
####################################################
|
||||
#
|
||||
# Hexadecimal File Ids
|
||||
#
|
||||
####################################################
|
||||
|
||||
$session->config->set('caseInsensitiveOS', 1);
|
||||
|
||||
my $hexStorage = WebGUI::Storage->create($session);
|
||||
ok($session->id->valid($hexStorage->getId), 'create returns valid sessionIds in hex mode');
|
||||
isnt($hexStorage->getId, $hexStorage->getFileId, 'getId != getFileId when caseInsentiveOS=1');
|
||||
is($session->id->toHex($hexStorage->getId), $hexStorage->getFileId, 'Hex value of GUID calculated correctly');
|
||||
my ($hexValue) = $session->db->quickArray('select hexValue,guidValue from storageTranslation where guidValue=?',[$hexStorage->getId]);
|
||||
is($hexStorage->getFileId, $hexValue, 'hexValue cached in the storageTranslation table');
|
||||
my ($part1, $part2) = unpack "A2A2A*", $hexStorage->getFileId; #fancy m/(..)(..)/;
|
||||
is ($hexStorage->{_part1}, $part1, 'Storage part1 uses hexId');
|
||||
is ($hexStorage->{_part2}, $part2, 'Storage part2 uses hexId, too');
|
||||
like ($hexStorage->getPath, qr/$hexValue/, 'Storage path uses hexId');
|
||||
|
||||
$session->config->set('caseInsensitiveOS', 0);
|
||||
|
||||
####################################################
|
||||
#
|
||||
# addFileFromFormPost
|
||||
|
|
|
|||
|
|
@ -177,6 +177,12 @@ sub size {
|
|||
return $self->{size};
|
||||
}
|
||||
|
||||
sub link {
|
||||
my $self = shift;
|
||||
my $dest = shift;
|
||||
return File::Copy::copy($self->filename, $dest);
|
||||
}
|
||||
|
||||
package WebGUI::PseudoRequest;
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue