C4/UploadedFiles.pm

   1 package C4::UploadedFiles;
   2
   3 # Copyright 2011-2012 BibLibre
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  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
  61 sub _get_file_path {
  62     my ($id, $dirname, $filename) = @_;
  63
  64     my $uploadPath = C4::Context->preference('uploadPath');
  65     my $filepath = "$uploadPath/$dirname/${id}_$filename";
  66     $filepath =~ s|/+|/|g;
  67
  68     return $filepath;
  69 }
  70
  71 =head2 GetUploadedFile
  72
  73     my $file = C4::UploadedFiles::GetUploadedFile($id);
  74
  75 Returns a hashref containing infos on uploaded files.
  76 Hash keys are:
  77
  78 =over 2
  79
  80 =item * id: id of the file (same as given in argument)
  81
  82 =item * filename: name of the file
  83
  84 =item * dir: directory where file is stored (relative to syspref 'uploadPath')
  85
  86 =back
  87
  88 It returns undef if file is not found
  89
  90 =cut
  91
  92 sub GetUploadedFile {
  93     my ($id) = @_;
  94
  95     return unless $id;
  96
  97     my $dbh = C4::Context->dbh;
  98     my $query = qq{
  99         SELECT id, filename, dir
 100         FROM uploaded_files
 101         WHERE id = ?
 102     };
 103     my $sth = $dbh->prepare($query);
 104     $sth->execute($id);
 105     my $file = $sth->fetchrow_hashref;
 106     if ($file) {
 107         $file->{filepath} = _get_file_path($file->{id}, $file->{dir},
 108             $file->{filename});
 109     }
 110
 111     return $file;
 112 }
 113
 114 =head2 UploadFile
 115
 116     my $id = C4::UploadedFiles::UploadFile($filename, $dir, $io_handle);
 117
 118 Upload a new file and returns its id (its SHA-1 sum, actually).
 119
 120 Parameters:
 121
 122 =over 2
 123
 124 =item * $filename: name of the file
 125
 126 =item * $dir: directory where to store the file (path relative to syspref 'uploadPath'
 127
 128 =item * $io_handle: valid IO::Handle object, can be retrieved with
 129 $cgi->upload('uploaded_file')->handle;
 130
 131 =back
 132
 133 =cut
 134
 135 sub UploadFile {
 136     my ($filename, $dir, $handle) = @_;
 137
 138     $filename = decode_utf8($filename);
 139     if($filename =~ m#(^|/)\.\.(/|$)# or $dir =~ m#(^|/)\.\.(/|$)#) {
 140         warn "Filename or dirname contains '..'. Aborting upload";
 141         return;
 142     }
 143
 144     my $buffer;
 145     my $data = '';
 146     while($handle->read($buffer, 1024)) {
 147         $data .= $buffer;
 148     }
 149     $handle->close;
 150
 151     my $sha = new Digest::SHA;
 152     $sha->add($data);
 153     my $id = $sha->hexdigest;
 154
 155     # Test if this id already exist
 156     my $file = GetUploadedFile($id);
 157     if ($file) {
 158         return $file->{id};
 159     }
 160
 161     my $file_path = _get_file_path($id, $dir, $filename);
 162
 163     my $out_fh;
 164     # Create the file only if it doesn't exist
 165     unless( sysopen($out_fh, $file_path, O_WRONLY|O_CREAT|O_EXCL) ) {
 166         warn "Failed to open file '$file_path': $!";
 167         return;
 168     }
 169
 170     print $out_fh $data;
 171     close $out_fh;
 172
 173     my $dbh = C4::Context->dbh;
 174     my $query = qq{
 175         INSERT INTO uploaded_files (id, filename, dir)
 176         VALUES (?,?, ?);
 177     };
 178     my $sth = $dbh->prepare($query);
 179     if($sth->execute($id, $filename, $dir)) {
 180         return $id;
 181     }
 182
 183     return undef;
 184 }
 185
 186 =head2 DelUploadedFile
 187
 188     C4::UploadedFiles::DelUploadedFile($id);
 189
 190 Remove a previously uploaded file, given its id.
 191
 192 Returns a false value if an error occurs.
 193
 194 =cut
 195
 196 sub DelUploadedFile {
 197     my ($id) = @_;
 198
 199     my $file = GetUploadedFile($id);
 200     if($file) {
 201         my $file_path = $file->{filepath};
 202         my $file_deleted = 0;
 203         unless( -f $file_path ) {
 204             warn "Id $file->{id} is in database but not in filesystem, removing id from database";
 205             $file_deleted = 1;
 206         } else {
 207             if(unlink $file_path) {
 208                 $file_deleted = 1;
 209             }
 210         }
 211
 212         unless($file_deleted) {
 213             warn "File $file_path cannot be deleted: $!";
 214         }
 215
 216         my $dbh = C4::Context->dbh;
 217         my $query = qq{
 218             DELETE FROM uploaded_files
 219             WHERE id = ?
 220         };
 221         my $sth = $dbh->prepare($query);
 222         return $sth->execute($id);
 223     }
 224 }
 225
 226 1;