C4/UploadedFiles.pm

   1 package C4::UploadedFiles;
   2
   3 # This file is part of Koha.
   4 #
   5 # Copyright (C) 2011-2012 BibLibre
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 =head1 NAME
  21
  22 C4::UploadedFiles - Functions to deal with files uploaded with cataloging plugin upload.pl
  23
  24 =head1 SYNOPSIS
  25
  26     use C4::UploadedFiles;
  27
  28     my $filename = $cgi->param('uploaded_file');
  29     my $file = $cgi->upload('uploaded_file');
  30     my $dir = $input->param('dir');
  31
  32     # upload file
  33     my $id = C4::UploadedFiles::UploadFile($filename, $dir, $file->handle);
  34
  35     # retrieve file infos
  36     my $uploaded_file = C4::UploadedFiles::GetUploadedFile($id);
  37
  38     # delete file
  39     C4::UploadedFiles::DelUploadedFile($id);
  40
  41 =head1 DESCRIPTION
  42
  43 This module provides basic functions for adding, retrieving and deleting files related to
  44 cataloging plugin upload.pl.
  45
  46 It uses uploaded_files table.
  47
  48 It is not related to C4::UploadedFile
  49
  50 =head1 FUNCTIONS
  51
  52 =cut
  53
  54 use Modern::Perl;
  55 use Digest::SHA;
  56 use Fcntl;
  57 use Encode;
  58
  59 use C4::Context;
  60 use C4::Koha;
  61
  62 sub _get_file_path {
  63     my ($hash, $dirname, $filename) = @_;
  64
  65     my $upload_path = C4::Context->config('upload_path');
  66     if( !-d "$upload_path/$dirname" ) {
  67         mkdir "$upload_path/$dirname";
  68     }
  69     my $filepath = "$upload_path/$dirname/${hash}_$filename";
  70     $filepath =~ s|/+|/|g;
  71
  72     return $filepath;
  73 }
  74
  75 =head2 GetUploadedFile
  76
  77     my $file = C4::UploadedFiles::GetUploadedFile($id);
  78
  79 Returns a hashref containing infos on uploaded files.
  80 Hash keys are:
  81
  82 =over 2
  83
  84 =item * id: id of the file (same as given in argument)
  85
  86 =item * filename: name of the file
  87
  88 =item * dir: directory where file is stored (relative to config variable 'upload_path')
  89
  90 =back
  91
  92 It returns undef if file is not found
  93
  94 =cut
  95
  96 sub GetUploadedFile {
  97     my ( $hashvalue ) = @_;
  98
  99     return unless $hashvalue;
 100
 101     my $dbh = C4::Context->dbh;
 102     my $query = qq{
 103         SELECT hashvalue, filename, dir
 104         FROM uploaded_files
 105         WHERE hashvalue = ?
 106     };
 107     my $sth = $dbh->prepare($query);
 108     $sth->execute( $hashvalue );
 109     my $file = $sth->fetchrow_hashref;
 110     if ($file) {
 111         $file->{filepath} = _get_file_path($file->{hashvalue}, $file->{dir},
 112             $file->{filename});
 113     }
 114
 115     return $file;
 116 }
 117
 118 =head2 UploadFile
 119
 120     my $id = C4::UploadedFiles::UploadFile($filename, $dir, $io_handle);
 121
 122 Upload a new file and returns its id (its SHA-1 sum, actually).
 123
 124 Parameters:
 125
 126 =over 2
 127
 128 =item * $filename: name of the file
 129
 130 =item * $dir: directory where to store the file (path relative to config variable 'upload_path'
 131
 132 =item * $io_handle: valid IO::Handle object, can be retrieved with
 133 $cgi->upload('uploaded_file')->handle;
 134
 135 =back
 136
 137 =cut
 138
 139 sub UploadFile {
 140     my ($filename, $dir, $handle) = @_;
 141     $filename = decode_utf8($filename);
 142     if($filename =~ m#(^|/)\.\.(/|$)# or $dir =~ m#(^|/)\.\.(/|$)#) {
 143         warn "Filename or dirname contains '..'. Aborting upload";
 144         return;
 145     }
 146
 147     my $buffer;
 148     my $data = '';
 149     while($handle->read($buffer, 1024)) {
 150         $data .= $buffer;
 151     }
 152     $handle->close;
 153
 154     my $sha = new Digest::SHA;
 155     $sha->add($data);
 156     $sha->add($filename);
 157     $sha->add($dir);
 158     my $hash = $sha->hexdigest;
 159
 160     # Test if this id already exist
 161     my $file = GetUploadedFile($hash);
 162     if ($file) {
 163         return $file->{hashvalue};
 164     }
 165
 166     my $file_path = _get_file_path($hash, $dir, $filename);
 167
 168     my $out_fh;
 169     # Create the file only if it doesn't exist
 170     unless( sysopen($out_fh, $file_path, O_WRONLY|O_CREAT|O_EXCL) ) {
 171         warn "Failed to open file '$file_path': $!";
 172         return;
 173     }
 174
 175     print $out_fh $data;
 176     my $size= tell($out_fh);
 177     close $out_fh;
 178
 179     my $dbh = C4::Context->dbh;
 180     my $query = qq{
 181         INSERT INTO uploaded_files (hashvalue, filename, filesize, dir, categorycode, owner) VALUES (?,?,?,?,?,?);
 182     };
 183     my $sth = $dbh->prepare($query);
 184     my $uid= C4::Context->userenv? C4::Context->userenv->{number}: undef;
 185         # uid is null in unit test
 186     if($sth->execute($hash, $filename, $size, $dir, $dir, $uid)) {
 187         return $hash;
 188     }
 189
 190     return;
 191 }
 192
 193 =head2 DanglingEntry
 194
 195     C4::UploadedFiles::DanglingEntry($id,$isfileuploadurl);
 196
 197 Determine if a entry is dangling.
 198
 199 Returns: 2 == no db entry
 200          1 == no plain file
 201          0 == both a file and db entry.
 202         -1 == N/A (undef id / non-file-upload URL)
 203
 204 =cut
 205
 206 sub DanglingEntry {
 207     my ($id,$isfileuploadurl) = @_;
 208     my $retval;
 209
 210     if (defined($id)) {
 211         my $file = GetUploadedFile($id);
 212         if($file) {
 213             my $file_path = $file->{filepath};
 214             my $file_deleted = 0;
 215             unless( -f $file_path ) {
 216                 $retval = 1;
 217             } else {
 218                 $retval = 0;
 219             }
 220         }
 221         else {
 222             if ( $isfileuploadurl ) {
 223                 $retval = 2;
 224             }
 225             else {
 226                 $retval = -1;
 227             }
 228         }
 229     }
 230     else {
 231         $retval = -1;
 232     }
 233     return $retval;
 234 }
 235
 236 =head2 DelUploadedFile
 237
 238     C4::UploadedFiles::DelUploadedFile( $hash );
 239
 240 Remove a previously uploaded file, given its hash value.
 241
 242 Returns: 1 == file deleted
 243          0 == file not deleted
 244          -1== no file to delete / no meaninful id passed
 245
 246 =cut
 247
 248 sub DelUploadedFile {
 249     my ( $hashval ) = @_;
 250     my $retval;
 251
 252     if ( $hashval ) {
 253         my $file = GetUploadedFile( $hashval );
 254         if($file) {
 255             my $file_path = $file->{filepath};
 256             my $file_deleted = 0;
 257             unless( -f $file_path ) {
 258                 warn "Id $file->{hashvalue} is in database but no plain file found, removing id from database";
 259                 $file_deleted = 1;
 260             } else {
 261                 if(unlink $file_path) {
 262                     $file_deleted = 1;
 263                 }
 264             }
 265
 266             unless($file_deleted) {
 267                 warn "File $file_path cannot be deleted: $!";
 268             }
 269
 270             my $dbh = C4::Context->dbh;
 271             my $query = qq{
 272                 DELETE FROM uploaded_files
 273                 WHERE hashvalue = ?
 274             };
 275             my $sth = $dbh->prepare($query);
 276             my $numrows = $sth->execute( $hashval );
 277             # if either a DB entry or file was deleted,
 278             # then clearly we have a deletion.
 279             if ($numrows>0 || $file_deleted==1) {
 280                 $retval = 1;
 281             }
 282             else {
 283                 $retval = 0;
 284             }
 285         }
 286         else {
 287             warn "There was no file for hash $hashval.";
 288             $retval = -1;
 289         }
 290     }
 291     else {
 292         warn "DelUploadFile called without hash value.";
 293         $retval = -1;
 294     }
 295     return $retval;
 296 }
 297
 298 =head2 getCategories
 299
 300     getCategories returns a list of upload category codes and names
 301
 302 =cut
 303
 304 sub getCategories {
 305     my $cats = C4::Koha::GetAuthorisedValues('UPLOAD');
 306     [ map {{ code => $_->{authorised_value}, name => $_->{lib} }} @$cats ];
 307 }
 308
 309 =head2 httpheaders
 310
 311     httpheaders returns http headers for a retrievable upload
 312     Will be extended by report 14282
 313
 314 =cut
 315
 316 sub httpheaders {
 317     my $file= shift;
 318     return
 319         ( '-type' => 'application/octet-stream',
 320           '-attachment' => $file, );
 321 }
 322
 323 1;