checking in the initial versions of Storage and Asset as well as some updates to other modules to make these work
This commit is contained in:
JT Smith
parent
9e741aff06
commit
c48831ad7b
5 changed files with 1200 additions and 18 deletions
611
lib/WebGUI/Storage.pm
Normal file
611
lib/WebGUI/Storage.pm
Normal file
|
|
@ -0,0 +1,611 @@
|
|||
package WebGUI::Storage;
|
||||
|
||||
=head1 LEGAL
|
||||
|
||||
-------------------------------------------------------------------
|
||||
WebGUI is Copyright 2001-2004 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
|
||||
-------------------------------------------------------------------
|
||||
|
||||
=cut
|
||||
|
||||
use Archive::Tar;
|
||||
use File::Copy qw(cp);
|
||||
use FileHandle;
|
||||
use File::Path;
|
||||
use POSIX;
|
||||
use strict;
|
||||
use WebGUI::ErrorHandler;
|
||||
use WebGUI::Id;
|
||||
use WebGUI::Session;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Package WebGUI::Storage
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This package provides a mechanism for storing and retrieving files that are not put into the database directly.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WebGUI::Storage;
|
||||
$store = WebGUI::Storage->create;
|
||||
$store = WebGUI::Storage->get($id);
|
||||
|
||||
$filename = $store->addFileFromFilesystem($pathToFile);
|
||||
$filename = $store->addFileFromHashref($filename,$hashref);
|
||||
$filename = $store->addFileFromScalar($filename,$content);
|
||||
|
||||
$integer = $store->getErrorCount;
|
||||
$hashref = $store->getFileContentsAsHashref($filename);
|
||||
$string = $store->getFileContentsAsScalar($filename);
|
||||
$string = $store->getFileExtension($filename);
|
||||
$arrayref = $store->getFiles;
|
||||
$string = $store->getFileSize($filename);
|
||||
$guid = $store->getId;
|
||||
$string = $store->getLastError;
|
||||
$string = $store->getPath($filename);
|
||||
$string = $store->getUrl($filename);
|
||||
|
||||
$newstore = $store->copy;
|
||||
$newstore = $store->tar($filename);
|
||||
$newstore = $store->untar($filename);
|
||||
|
||||
|
||||
$store->delete;
|
||||
$store->deleteFile($filename);
|
||||
$store->rename($filename, $newFilename);
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
These methods are available from this package:
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 _addError ( errorMessage )
|
||||
|
||||
Adds an error message to the object.
|
||||
|
||||
NOTE: This is a private method and should never be called except internally to this package.
|
||||
|
||||
=head3 errorMessage
|
||||
|
||||
The error message to add to the object.
|
||||
|
||||
=cut
|
||||
|
||||
sub _addError {
|
||||
my $self = shift;
|
||||
my $errorMessage = shift;
|
||||
push(@$self->{_errors},$errorMessage);
|
||||
WebGUI::ErrorHandler::warn($errorMessage);
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 _getStorageParts
|
||||
|
||||
Returns an array reference containing the hashed values for the storage location directory.
|
||||
|
||||
NOTE: This is a private method and should never be called except internally to this package.
|
||||
|
||||
=cut
|
||||
|
||||
sub _getStorageParts {
|
||||
my $self = shift;
|
||||
my $id = shift;
|
||||
$id =~ m/^(.{2})(.{2})/;
|
||||
return [$1,$2]
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 addFileFromFilesystem( pathToFile )
|
||||
|
||||
Grabs a file from the server's file system and saves it to a storage location and returns a URL compliant filename.
|
||||
|
||||
=head3 pathToFile
|
||||
|
||||
Provide the local path to this file.
|
||||
|
||||
=cut
|
||||
|
||||
sub saveFromFilesystem {
|
||||
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 = WebGUI::URL::makeCompliant($filename);
|
||||
if (-d $pathToFile) {
|
||||
WebGUI::ErrorHandler::warn($pathToFile." is a directory, not a file.");
|
||||
} else {
|
||||
$a = FileHandle->new($pathToFile,"r");
|
||||
if (defined $a) {
|
||||
binmode($a);
|
||||
$b = FileHandle->new(">".$self->getPath($filename));
|
||||
if (defined $b) {
|
||||
binmode($b);
|
||||
cp($a,$b) or $self->_addError("Couldn't copy $pathToFile to ".$self->getPath($filename).": $!");
|
||||
$b->close;
|
||||
} else {
|
||||
$self->_addError("Couldn't open file ".$self->getPath($filename)." for writing due to error: ".$!);
|
||||
$filename = undef;
|
||||
}
|
||||
$a->close;
|
||||
} else {
|
||||
$self->_addError("Couldn't open file ".$pathToFile." for reading due to error: ".$!);
|
||||
$filename = undef;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
$filename = undef;
|
||||
}
|
||||
return $filename;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 addFileFromHashref ( filename, hashref )
|
||||
|
||||
Stores a hash reference as a file and returns a URL compliant filename. Retrieve the data with getFileContentsAsHashref.
|
||||
|
||||
=head3 filename
|
||||
|
||||
The name of the file to create.
|
||||
|
||||
=head3 hashref
|
||||
|
||||
A hash reference containing the data you wish to persist to the filesystem.
|
||||
|
||||
=cut
|
||||
|
||||
sub addFileFromHashref {
|
||||
my $self = shift;
|
||||
my $filename = WebGUI::URL::makeCompliant(shift);
|
||||
my $hashref = shift;
|
||||
store $hashref, $self->getPath($filename) or $self->_addError("Couldn't create file ".$self->getPath($filename)." because ".$!);
|
||||
return $filename;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 addFileFromScalar ( filename, content )
|
||||
|
||||
Adds a file to this storage location and returns a URL compliant filename.
|
||||
|
||||
=head3 filename
|
||||
|
||||
The filename to create.
|
||||
|
||||
=head3 content
|
||||
|
||||
The content to write to the file.
|
||||
|
||||
=cut
|
||||
|
||||
sub addFileFromScalar {
|
||||
my $self = shift;
|
||||
my $filename = WebGUI::URL::makeCompliant(shift);
|
||||
my $content = shift;
|
||||
if (open(FILE,">".$self->getPath($filename))) {
|
||||
print FILE $content;
|
||||
close(FILE);
|
||||
} else {
|
||||
$self->_addError("Couldn't create file ".$self->getPath($filename)." because ".$!);
|
||||
}
|
||||
return $filename;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 copy ( )
|
||||
|
||||
Copies a storage location and it's contents. Returns a new storage location object. Note that this does not copy privileges or other special filesystem properties.
|
||||
|
||||
=cut
|
||||
|
||||
sub copy {
|
||||
my $self = shift;
|
||||
my $newStorage = WebGUI::Storage->create;
|
||||
my $filelist = $self->getFiles;
|
||||
foreach my $file (@{$filelist}) {
|
||||
$a = FileHandle->new($self->getPath($file),"r");
|
||||
if (defined $a) {
|
||||
binmode($a);
|
||||
$b = FileHandle->new(">".$newStorage->getPath($file));
|
||||
if (defined $b) {
|
||||
binmode($b);
|
||||
cp($a,$b) or $self->_addError("Couldn't copy file ".$self->getPath($file)." to ".$newStorage->getPath($file)." because ".$!);
|
||||
$b->close;
|
||||
}
|
||||
$a->close;
|
||||
}
|
||||
}
|
||||
return $newStorage;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 create ( )
|
||||
|
||||
Creates a new storage location on the file system.
|
||||
|
||||
=cut
|
||||
|
||||
sub create {
|
||||
my $class = shift;
|
||||
my $id = WebGUI::Id::generate();
|
||||
my $self = $class->get($id);
|
||||
my $parts = $self->_getStorageParts($id);
|
||||
my $node = $session{config}{uploadsPath}.$session{os}{slash}.$parts->[0];
|
||||
mkdir($node);
|
||||
unless ($! eq "File exists" || $! eq "") {
|
||||
$self->_addError("Couldn't create storage location: $node : $!");
|
||||
}
|
||||
$node .= $session{os}{slash}.$parts->[1];
|
||||
mkdir($node);
|
||||
unless ($! eq "File exists" || $! eq "") {
|
||||
$self->_addError("Couldn't create storage location: $node : $!");
|
||||
}
|
||||
$node .= $session{os}{slash}.$id;
|
||||
mkdir($node);
|
||||
unless ($! eq "") {
|
||||
$self->_addError("Couldn't create storage location: $node : $!");
|
||||
}
|
||||
return $self;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 delete ( )
|
||||
|
||||
Deletes this storage location and its contents (if any) from the filesystem and destroy's the object.
|
||||
|
||||
=cut
|
||||
|
||||
sub delete {
|
||||
my $self = shift;
|
||||
rmtree($self->getPath);
|
||||
undef $self;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 deleteFile ( filename )
|
||||
|
||||
Deletes a file from it's storage location.
|
||||
|
||||
=head3 filename
|
||||
|
||||
The name of the file to delete.
|
||||
|
||||
=cut
|
||||
|
||||
sub deleteFile {
|
||||
my $self = shift;
|
||||
my $filename = shift;
|
||||
unlink($self->getPath($filename));
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 get ( id )
|
||||
|
||||
Returns a WebGUI::Storage object.
|
||||
|
||||
=head3 id
|
||||
|
||||
The unique identifier for this file system storage location.
|
||||
|
||||
=cut
|
||||
|
||||
sub get {
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $parts = _getStorageParts($id);
|
||||
bless {_id => $id, _part1 => $part->[0], _part2 => $part->[1]}, $class;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getErrorCount ( )
|
||||
|
||||
Returns the number of errors that have been generated on this object instance.
|
||||
|
||||
=cut
|
||||
|
||||
sub getErrorCount {
|
||||
my $self = shift;
|
||||
my $count = scalar(@{$self->{_errors}});
|
||||
return $count;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getFileContentsAsScalar ( filename )
|
||||
|
||||
Reads the contents of a file into a scalar variable and returns the scalar.
|
||||
|
||||
=head3 filename
|
||||
|
||||
The name of the file to read from.
|
||||
|
||||
=cut
|
||||
|
||||
sub getFileContentsAsScalar {
|
||||
my $self = shift;
|
||||
my $filename = shift;
|
||||
my $content;
|
||||
open (FILE,"<".$self->getPath($filename));
|
||||
while (<FILE>) {
|
||||
$content .= $_;
|
||||
}
|
||||
close(FILE);
|
||||
return $content;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getFileSize ( filename )
|
||||
|
||||
Returns the size of this file.
|
||||
|
||||
=cut
|
||||
|
||||
sub getFileSize {
|
||||
my $self = shift;
|
||||
my $filename = shift;
|
||||
my ($size);
|
||||
my (@attributes) = stat($self->getPath($filename));
|
||||
if ($attributes[7] > 1048576) {
|
||||
$size = round($attributes[7]/1048576);
|
||||
$size .= 'MB';
|
||||
} elsif ($attributes[7] > 1024) {
|
||||
$size = round($attributes[7]/1024);
|
||||
$size .= 'kB';
|
||||
} else {
|
||||
$size = $attributes[7]."B";
|
||||
}
|
||||
return $size;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getFiles ( )
|
||||
|
||||
Returns an array reference of the files in this storage location.
|
||||
|
||||
=cut
|
||||
|
||||
sub getFiles ( ) {
|
||||
my $self = shift;
|
||||
my @list;
|
||||
if (opendir (DIR,$self->getPath)) {
|
||||
my @files = readdir(DIR);
|
||||
closedir(DIR);
|
||||
foreach my $file (@files) {
|
||||
unless ($file =~ m/^\./) { # don't show files starting with a dot
|
||||
push(@list,$file);
|
||||
}
|
||||
}
|
||||
return \@list;
|
||||
}
|
||||
return [];
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getFileExtension ( filename )
|
||||
|
||||
Returns the extension or type of this file.
|
||||
|
||||
=head3 filename
|
||||
|
||||
The filename of the file you wish to find out the type for.
|
||||
|
||||
=cut
|
||||
|
||||
sub getFileExtension {
|
||||
my $filename = shift;
|
||||
my $extension = lc($filename);
|
||||
$extension =~ s/.*\.(.*?)$/$1/;
|
||||
return $extension;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getFileContentsAsHashref ( filename )
|
||||
|
||||
Returns a hash reference from the file. Must be used in conjunction with a file that was saved using the addFileFromHashref method.
|
||||
|
||||
=head3 filename
|
||||
|
||||
The file to retrieve the data from.
|
||||
|
||||
=cut
|
||||
|
||||
sub getHashref {
|
||||
my $self = shift;
|
||||
my $filename = shift;
|
||||
return retrieve($self->getPath($filename));
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getId ()
|
||||
|
||||
Returns the unique identifier of this storage location.
|
||||
|
||||
=cut
|
||||
|
||||
sub getId {
|
||||
my $self = shift;
|
||||
return $self->{_id};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getLastError ()
|
||||
|
||||
Returns the most recently generated error message.
|
||||
|
||||
=cut
|
||||
|
||||
sub getLastError {
|
||||
my $self = shift;
|
||||
my $count = $self->getErrorCount;
|
||||
return $self->{_errors}[$count-1];
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getPath ( [ file ] )
|
||||
|
||||
Returns a full path to this storage location.
|
||||
|
||||
=head3 file
|
||||
|
||||
If specified, we'll return a path to the file rather than the storage location.
|
||||
|
||||
=cut
|
||||
|
||||
sub getPath {
|
||||
my $self = shift;
|
||||
my $file = shift;
|
||||
my $path = $session{config}{uploadsPath}
|
||||
.$session{os}{slash}.$self->{_part1}
|
||||
.$session{os}{slash}.$self->{_part2}
|
||||
.$session{os}{slash}.$self->getId;
|
||||
if (defined $file) {
|
||||
$path .= $session{os}{slash}.$file;
|
||||
}
|
||||
return $path;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getUrl ( [ file ] )
|
||||
|
||||
Returns a URL to this storage location.
|
||||
|
||||
=head3 file
|
||||
|
||||
If specified, we'll return a URL to the file rather than the storage location.
|
||||
|
||||
=cut
|
||||
|
||||
sub getUrl {
|
||||
my $self = shift;
|
||||
my $file = shift;
|
||||
my $url = $session{config}{uploadsURL}.'/'.$self->{_part1}.'/'.$self->{_part2}.'/'.$self->getId;
|
||||
if (defined $file) {
|
||||
$url .= '/'.$file;
|
||||
}
|
||||
return $url;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 renameFile ( filename, newFilename )
|
||||
|
||||
Renames an file's filename.
|
||||
|
||||
=head3 filename
|
||||
|
||||
The name of the file you wish to rename.
|
||||
|
||||
=head3 newFilename
|
||||
|
||||
Define the new filename a specified file.
|
||||
|
||||
=cut
|
||||
|
||||
sub renameFile {
|
||||
my $self = shift;
|
||||
my $filename = shift;
|
||||
my $newFilename = shift;
|
||||
rename $self->getPath($filename), $self->getNode->getPath($newFilename);
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 tar ( filename )
|
||||
|
||||
Archives this storage location into a tar file and then compresses it with a zlib algorithm. It then returns a new WebGUI::Storage object for the archive.
|
||||
|
||||
=head3 filename
|
||||
|
||||
The name of the tar file to be created. Should ideally end with ".tar.gz".
|
||||
|
||||
=cut
|
||||
|
||||
sub tar {
|
||||
my $self = shift;
|
||||
my $filename = shift;
|
||||
chdir $self->getPath;
|
||||
my $temp = WebGUI::Node->create;
|
||||
if ($Archive::Tar::VERSION eq '0.072') {
|
||||
my $tar = Archive::Tar->new();
|
||||
$tar->add_files($self->getFiles);
|
||||
$tar->write($temp->getPath($filename),1);
|
||||
|
||||
} else {
|
||||
Archive::Tar->create_archive($temp->getPath($filename),1,$self->getFiles);
|
||||
}
|
||||
return $temp;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 untar ( filename )
|
||||
|
||||
Unarchives a file into a new storage location. Returns the new WebGUI::Storage object.
|
||||
|
||||
=head3 filename
|
||||
|
||||
The name of the tar file to be untarred.
|
||||
|
||||
=cut
|
||||
|
||||
sub untar {
|
||||
my $self = shift;
|
||||
my $filename = shift;
|
||||
my $temp = WebGUI::Node->create;
|
||||
chdir $temp->getPath;
|
||||
Archive::Tar->extract_archive($self->getPath($filename),1);
|
||||
$self->_addError(Archive::Tar->error) if (Archive::Tar->error);
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
|
||||
Loading…
Add table
Add a link
Reference in a new issue