package C4::UploadedFiles;
-# Copyright 2011-2012 BibLibre
-#
# This file is part of Koha.
#
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.
+# Copyright (C) 2011-2012 BibLibre
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
#
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
#
-# You should have received a copy of the GNU General Public License along
-# with Koha; if not, write to the Free Software Foundation, Inc.,
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
=head1 NAME
use Encode;
use C4::Context;
+use C4::Koha;
sub _get_file_path {
- my ($id, $dirname, $filename) = @_;
+ my ($hash, $dirname, $filename) = @_;
- my $uploadPath = C4::Context->preference('uploadPath');
- my $filepath = "$uploadPath/$dirname/${id}_$filename";
+ my $upload_path = C4::Context->config('upload_path');
+ if( !-d "$upload_path/$dirname" ) {
+ mkdir "$upload_path/$dirname";
+ }
+ my $filepath = "$upload_path/$dirname/${hash}_$filename";
$filepath =~ s|/+|/|g;
return $filepath;
=item * filename: name of the file
-=item * dir: directory where file is stored (relative to syspref 'uploadPath')
+=item * dir: directory where file is stored (relative to config variable 'upload_path')
=back
=cut
sub GetUploadedFile {
- my ($id) = @_;
+ my ( $hashvalue ) = @_;
- return unless $id;
+ return unless $hashvalue;
my $dbh = C4::Context->dbh;
my $query = qq{
- SELECT id, filename, dir
+ SELECT hashvalue, filename, dir
FROM uploaded_files
- WHERE id = ?
+ WHERE hashvalue = ?
};
my $sth = $dbh->prepare($query);
- $sth->execute($id);
+ $sth->execute( $hashvalue );
my $file = $sth->fetchrow_hashref;
if ($file) {
- $file->{filepath} = _get_file_path($file->{id}, $file->{dir},
+ $file->{filepath} = _get_file_path($file->{hashvalue}, $file->{dir},
$file->{filename});
}
=item * $filename: name of the file
-=item * $dir: directory where to store the file (path relative to syspref 'uploadPath'
+=item * $dir: directory where to store the file (path relative to config variable 'upload_path'
=item * $io_handle: valid IO::Handle object, can be retrieved with
$cgi->upload('uploaded_file')->handle;
sub UploadFile {
my ($filename, $dir, $handle) = @_;
-
$filename = decode_utf8($filename);
if($filename =~ m#(^|/)\.\.(/|$)# or $dir =~ m#(^|/)\.\.(/|$)#) {
warn "Filename or dirname contains '..'. Aborting upload";
my $sha = new Digest::SHA;
$sha->add($data);
- my $id = $sha->hexdigest;
+ $sha->add($filename);
+ $sha->add($dir);
+ my $hash = $sha->hexdigest;
# Test if this id already exist
- my $file = GetUploadedFile($id);
+ my $file = GetUploadedFile($hash);
if ($file) {
- return $file->{id};
+ return $file->{hashvalue};
}
- my $file_path = _get_file_path($id, $dir, $filename);
+ my $file_path = _get_file_path($hash, $dir, $filename);
my $out_fh;
# Create the file only if it doesn't exist
}
print $out_fh $data;
+ my $size= tell($out_fh);
close $out_fh;
my $dbh = C4::Context->dbh;
my $query = qq{
- INSERT INTO uploaded_files (id, filename, dir)
- VALUES (?,?, ?);
+ INSERT INTO uploaded_files (hashvalue, filename, filesize, dir, categorycode, owner) VALUES (?,?,?,?,?,?);
};
my $sth = $dbh->prepare($query);
- if($sth->execute($id, $filename, $dir)) {
- return $id;
+ my $uid= C4::Context->userenv? C4::Context->userenv->{number}: undef;
+ # uid is null in unit test
+ if($sth->execute($hash, $filename, $size, $dir, $dir, $uid)) {
+ return $hash;
}
- return undef;
+ return;
+}
+
+=head2 DanglingEntry
+
+ C4::UploadedFiles::DanglingEntry($id,$isfileuploadurl);
+
+Determine if a entry is dangling.
+
+Returns: 2 == no db entry
+ 1 == no plain file
+ 0 == both a file and db entry.
+ -1 == N/A (undef id / non-file-upload URL)
+
+=cut
+
+sub DanglingEntry {
+ my ($id,$isfileuploadurl) = @_;
+ my $retval;
+
+ if (defined($id)) {
+ my $file = GetUploadedFile($id);
+ if($file) {
+ my $file_path = $file->{filepath};
+ my $file_deleted = 0;
+ unless( -f $file_path ) {
+ $retval = 1;
+ } else {
+ $retval = 0;
+ }
+ }
+ else {
+ if ( $isfileuploadurl ) {
+ $retval = 2;
+ }
+ else {
+ $retval = -1;
+ }
+ }
+ }
+ else {
+ $retval = -1;
+ }
+ return $retval;
}
=head2 DelUploadedFile
- C4::UploadedFiles::DelUploadedFile($id);
+ C4::UploadedFiles::DelUploadedFile( $hash );
-Remove a previously uploaded file, given its id.
+Remove a previously uploaded file, given its hash value.
-Returns a false value if an error occurs.
+Returns: 1 == file deleted
+ 0 == file not deleted
+ -1== no file to delete / no meaninful id passed
=cut
sub DelUploadedFile {
- my ($id) = @_;
-
- my $file = GetUploadedFile($id);
- if($file) {
- my $file_path = $file->{filepath};
- my $file_deleted = 0;
- unless( -f $file_path ) {
- warn "Id $file->{id} is in database but not in filesystem, removing id from database";
- $file_deleted = 1;
- } else {
- if(unlink $file_path) {
+ my ( $hashval ) = @_;
+ my $retval;
+
+ if ( $hashval ) {
+ my $file = GetUploadedFile( $hashval );
+ if($file) {
+ my $file_path = $file->{filepath};
+ my $file_deleted = 0;
+ unless( -f $file_path ) {
+ warn "Id $file->{hashvalue} is in database but no plain file found, removing id from database";
$file_deleted = 1;
+ } else {
+ if(unlink $file_path) {
+ $file_deleted = 1;
+ }
}
- }
- unless($file_deleted) {
- warn "File $file_path cannot be deleted: $!";
- }
+ unless($file_deleted) {
+ warn "File $file_path cannot be deleted: $!";
+ }
- my $dbh = C4::Context->dbh;
- my $query = qq{
- DELETE FROM uploaded_files
- WHERE id = ?
- };
- my $sth = $dbh->prepare($query);
- return $sth->execute($id);
+ my $dbh = C4::Context->dbh;
+ my $query = qq{
+ DELETE FROM uploaded_files
+ WHERE hashvalue = ?
+ };
+ my $sth = $dbh->prepare($query);
+ my $numrows = $sth->execute( $hashval );
+ # if either a DB entry or file was deleted,
+ # then clearly we have a deletion.
+ if ($numrows>0 || $file_deleted==1) {
+ $retval = 1;
+ }
+ else {
+ $retval = 0;
+ }
+ }
+ else {
+ warn "There was no file for hash $hashval.";
+ $retval = -1;
+ }
+ }
+ else {
+ warn "DelUploadFile called without hash value.";
+ $retval = -1;
}
+ return $retval;
+}
+
+=head2 getCategories
+
+ getCategories returns a list of upload category codes and names
+
+=cut
+
+sub getCategories {
+ my $cats = C4::Koha::GetAuthorisedValues('UPLOAD');
+ [ map {{ code => $_->{authorised_value}, name => $_->{lib} }} @$cats ];
+}
+
+=head2 httpheaders
+
+ httpheaders returns http headers for a retrievable upload
+ Will be extended by report 14282
+
+=cut
+
+sub httpheaders {
+ my $file= shift;
+ return
+ ( '-type' => 'application/octet-stream',
+ '-attachment' => $file, );
}
1;
projects / koha.git / blobdiff