1 package C4
::UploadedFiles
;
3 # This file is part of Koha.
5 # Copyright (C) 2011-2012 BibLibre
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.
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.
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>.
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
63 my ($hash, $dirname, $filename) = @_;
65 my $upload_path = C4
::Context
->config('upload_path');
66 if( !-d
"$upload_path/$dirname" ) {
67 mkdir "$upload_path/$dirname";
69 my $filepath = "$upload_path/$dirname/${hash}_$filename";
70 $filepath =~ s
|/+|/|g
;
75 =head2 GetUploadedFile
77 my $file = C4::UploadedFiles::GetUploadedFile($id);
79 Returns a hashref containing infos on uploaded files.
84 =item * id: id of the file (same as given in argument)
86 =item * filename: name of the file
88 =item * dir: directory where file is stored (relative to config variable 'upload_path')
92 It returns undef if file is not found
97 my ( $hashvalue ) = @_;
99 return unless $hashvalue;
101 my $dbh = C4
::Context
->dbh;
103 SELECT hashvalue
, filename
, dir
107 my $sth = $dbh->prepare($query);
108 $sth->execute( $hashvalue );
109 my $file = $sth->fetchrow_hashref;
111 $file->{filepath
} = _get_file_path
($file->{hashvalue
}, $file->{dir
},
120 my $id = C4::UploadedFiles::UploadFile($filename, $dir, $io_handle);
122 Upload a new file and returns its id (its SHA-1 sum, actually).
128 =item * $filename: name of the file
130 =item * $dir: directory where to store the file (path relative to config variable 'upload_path'
132 =item * $io_handle: valid IO::Handle object, can be retrieved with
133 $cgi->upload('uploaded_file')->handle;
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";
149 while($handle->read($buffer, 1024)) {
154 my $sha = new Digest
::SHA
;
156 $sha->add($filename);
158 my $hash = $sha->hexdigest;
160 # Test if this id already exist
161 my $file = GetUploadedFile
($hash);
163 return $file->{hashvalue
};
166 my $file_path = _get_file_path
($hash, $dir, $filename);
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': $!";
176 my $size= tell($out_fh);
179 my $dbh = C4
::Context
->dbh;
181 INSERT INTO uploaded_files
(hashvalue
, filename
, filesize
, dir
, categorycode
, owner
) VALUES
(?
,?
,?
,?
,?
,?
);
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)) {
195 C4::UploadedFiles::DanglingEntry($id,$isfileuploadurl);
197 Determine if a entry is dangling.
199 Returns: 2 == no db entry
201 0 == both a file and db entry.
202 -1 == N/A (undef id / non-file-upload URL)
207 my ($id,$isfileuploadurl) = @_;
211 my $file = GetUploadedFile
($id);
213 my $file_path = $file->{filepath
};
214 my $file_deleted = 0;
215 unless( -f
$file_path ) {
222 if ( $isfileuploadurl ) {
236 =head2 DelUploadedFile
238 C4::UploadedFiles::DelUploadedFile( $hash );
240 Remove a previously uploaded file, given its hash value.
242 Returns: 1 == file deleted
243 0 == file not deleted
244 -1== no file to delete / no meaninful id passed
248 sub DelUploadedFile
{
249 my ( $hashval ) = @_;
253 my $file = GetUploadedFile
( $hashval );
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";
261 if(unlink $file_path) {
266 unless($file_deleted) {
267 warn "File $file_path cannot be deleted: $!";
270 my $dbh = C4
::Context
->dbh;
272 DELETE FROM uploaded_files
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) {
287 warn "There was no file for hash $hashval.";
292 warn "DelUploadFile called without hash value.";
300 getCategories returns a list of upload category codes and names
305 my $cats = C4
::Koha
::GetAuthorisedValues
('UPLOAD');
306 [ map {{ code
=> $_->{authorised_value
}, name
=> $_->{lib
} }} @
$cats ];
311 httpheaders returns http headers for a retrievable upload
312 Will be extended by report 14282
319 ( '-type' => 'application/octet-stream',
320 '-attachment' => $file, );