324 lines
7.5 KiB
Perl
324 lines
7.5 KiB
Perl
package C4::UploadedFiles;
|
|
|
|
# This file is part of Koha.
|
|
#
|
|
# 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.
|
|
#
|
|
# 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
|
|
|
|
C4::UploadedFiles - Functions to deal with files uploaded with cataloging plugin upload.pl
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use C4::UploadedFiles;
|
|
|
|
my $filename = $cgi->param('uploaded_file');
|
|
my $file = $cgi->upload('uploaded_file');
|
|
my $dir = $input->param('dir');
|
|
|
|
# upload file
|
|
my $id = C4::UploadedFiles::UploadFile($filename, $dir, $file->handle);
|
|
|
|
# retrieve file infos
|
|
my $uploaded_file = C4::UploadedFiles::GetUploadedFile($id);
|
|
|
|
# delete file
|
|
C4::UploadedFiles::DelUploadedFile($id);
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This module provides basic functions for adding, retrieving and deleting files related to
|
|
cataloging plugin upload.pl.
|
|
|
|
It uses uploaded_files table.
|
|
|
|
It is not related to C4::UploadedFile
|
|
|
|
=head1 FUNCTIONS
|
|
|
|
=cut
|
|
|
|
use Modern::Perl;
|
|
use Digest::SHA;
|
|
use Fcntl;
|
|
use Encode;
|
|
|
|
use C4::Context;
|
|
use C4::Koha;
|
|
|
|
sub _get_file_path {
|
|
my ($hash, $dirname, $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;
|
|
}
|
|
|
|
=head2 GetUploadedFile
|
|
|
|
my $file = C4::UploadedFiles::GetUploadedFile($id);
|
|
|
|
Returns a hashref containing infos on uploaded files.
|
|
Hash keys are:
|
|
|
|
=over 2
|
|
|
|
=item * id: id of the file (same as given in argument)
|
|
|
|
=item * filename: name of the file
|
|
|
|
=item * dir: directory where file is stored (relative to config variable 'upload_path')
|
|
|
|
=back
|
|
|
|
It returns undef if file is not found
|
|
|
|
=cut
|
|
|
|
sub GetUploadedFile {
|
|
my ( $hashvalue ) = @_;
|
|
|
|
return unless $hashvalue;
|
|
|
|
my $dbh = C4::Context->dbh;
|
|
my $query = qq{
|
|
SELECT hashvalue, filename, dir
|
|
FROM uploaded_files
|
|
WHERE hashvalue = ?
|
|
};
|
|
my $sth = $dbh->prepare($query);
|
|
$sth->execute( $hashvalue );
|
|
my $file = $sth->fetchrow_hashref;
|
|
if ($file) {
|
|
$file->{filepath} = _get_file_path($file->{hashvalue}, $file->{dir},
|
|
$file->{filename});
|
|
}
|
|
|
|
return $file;
|
|
}
|
|
|
|
=head2 UploadFile
|
|
|
|
my $id = C4::UploadedFiles::UploadFile($filename, $dir, $io_handle);
|
|
|
|
Upload a new file and returns its id (its SHA-1 sum, actually).
|
|
|
|
Parameters:
|
|
|
|
=over 2
|
|
|
|
=item * $filename: name of the file
|
|
|
|
=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;
|
|
|
|
=back
|
|
|
|
=cut
|
|
|
|
sub UploadFile {
|
|
my ($filename, $dir, $handle) = @_;
|
|
$filename = decode_utf8($filename);
|
|
if($filename =~ m#(^|/)\.\.(/|$)# or $dir =~ m#(^|/)\.\.(/|$)#) {
|
|
warn "Filename or dirname contains '..'. Aborting upload";
|
|
return;
|
|
}
|
|
|
|
my $buffer;
|
|
my $data = '';
|
|
while($handle->read($buffer, 1024)) {
|
|
$data .= $buffer;
|
|
}
|
|
$handle->close;
|
|
|
|
my $sha = new Digest::SHA;
|
|
$sha->add($data);
|
|
$sha->add($filename);
|
|
$sha->add($dir);
|
|
my $hash = $sha->hexdigest;
|
|
|
|
# Test if this id already exist
|
|
my $file = GetUploadedFile($hash);
|
|
if ($file) {
|
|
return $file->{hashvalue};
|
|
}
|
|
|
|
my $file_path = _get_file_path($hash, $dir, $filename);
|
|
|
|
my $out_fh;
|
|
# Create the file only if it doesn't exist
|
|
unless( sysopen($out_fh, $file_path, O_WRONLY|O_CREAT|O_EXCL) ) {
|
|
warn "Failed to open file '$file_path': $!";
|
|
return;
|
|
}
|
|
|
|
print $out_fh $data;
|
|
my $size= tell($out_fh);
|
|
close $out_fh;
|
|
|
|
my $dbh = C4::Context->dbh;
|
|
my $query = qq{
|
|
INSERT INTO uploaded_files (hashvalue, filename, filesize, dir, categorycode, owner) VALUES (?,?,?,?,?,?);
|
|
};
|
|
my $sth = $dbh->prepare($query);
|
|
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;
|
|
}
|
|
|
|
=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( $hash );
|
|
|
|
Remove a previously uploaded file, given its hash value.
|
|
|
|
Returns: 1 == file deleted
|
|
0 == file not deleted
|
|
-1== no file to delete / no meaninful id passed
|
|
|
|
=cut
|
|
|
|
sub DelUploadedFile {
|
|
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: $!";
|
|
}
|
|
|
|
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;
|