1 package C4::UploadedFiles;
3 # Copyright 2011-2012 BibLibre
5 # This file is part of Koha.
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
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.
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.
22 C4::UploadedFiles - Functions to deal with files uploaded with cataloging plugin upload.pl
26 use C4::UploadedFiles;
28 my $filename = $cgi->param('uploaded_file');
29 my $file = $cgi->upload('uploaded_file');
30 my $dir = $input->param('dir');
33 my $id = C4::UploadedFiles::UploadFile($filename, $dir, $file->handle);
36 my $uploaded_file = C4::UploadedFiles::GetUploadedFile($id);
39 C4::UploadedFiles::DelUploadedFile($id);
43 This module provides basic functions for adding, retrieving and deleting files related to
44 cataloging plugin upload.pl.
46 It uses uploaded_files table.
48 It is not related to C4::UploadedFile
62 my ($id, $dirname, $filename) = @_;
64 my $upload_path = C4::Context->config('upload_path');
65 my $filepath = "$upload_path/$dirname/${id}_$filename";
66 $filepath =~ s|/+|/|g;
71 =head2 GetUploadedFile
73 my $file = C4::UploadedFiles::GetUploadedFile($id);
75 Returns a hashref containing infos on uploaded files.
80 =item * id: id of the file (same as given in argument)
82 =item * filename: name of the file
84 =item * dir: directory where file is stored (relative to config variable 'upload_path')
88 It returns undef if file is not found
97 my $dbh = C4::Context->dbh;
99 SELECT id, filename, dir
103 my $sth = $dbh->prepare($query);
105 my $file = $sth->fetchrow_hashref;
107 $file->{filepath} = _get_file_path($file->{id}, $file->{dir},
116 my $id = C4::UploadedFiles::UploadFile($filename, $dir, $io_handle);
118 Upload a new file and returns its id (its SHA-1 sum, actually).
124 =item * $filename: name of the file
126 =item * $dir: directory where to store the file (path relative to config variable 'upload_path'
128 =item * $io_handle: valid IO::Handle object, can be retrieved with
129 $cgi->upload('uploaded_file')->handle;
136 my ($filename, $dir, $handle) = @_;
138 $filename = decode_utf8($filename);
139 if($filename =~ m#(^|/)\.\.(/|$)# or $dir =~ m#(^|/)\.\.(/|$)#) {
140 warn "Filename or dirname contains '..'. Aborting upload";
146 while($handle->read($buffer, 1024)) {
151 my $sha = new Digest::SHA;
153 my $id = $sha->hexdigest;
155 # Test if this id already exist
156 my $file = GetUploadedFile($id);
161 my $file_path = _get_file_path($id, $dir, $filename);
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': $!";
173 my $dbh = C4::Context->dbh;
175 INSERT INTO uploaded_files (id, filename, dir)
178 my $sth = $dbh->prepare($query);
179 if($sth->execute($id, $filename, $dir)) {
186 =head2 DelUploadedFile
188 C4::UploadedFiles::DelUploadedFile($id);
190 Remove a previously uploaded file, given its id.
192 Returns a false value if an error occurs.
196 sub DelUploadedFile {
199 my $file = GetUploadedFile($id);
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";
207 if(unlink $file_path) {
212 unless($file_deleted) {
213 warn "File $file_path cannot be deleted: $!";
216 my $dbh = C4::Context->dbh;
218 DELETE FROM uploaded_files
221 my $sth = $dbh->prepare($query);
222 return $sth->execute($id);