|
Lines 57-68
use Fcntl;
Link Here
|
| 57 |
use Encode; |
57 |
use Encode; |
| 58 |
|
58 |
|
| 59 |
use C4::Context; |
59 |
use C4::Context; |
|
|
60 |
use C4::Koha; |
| 60 |
|
61 |
|
| 61 |
sub _get_file_path { |
62 |
sub _get_file_path { |
| 62 |
my ($id, $dirname, $filename) = @_; |
63 |
my ($hash, $dirname, $filename) = @_; |
| 63 |
|
64 |
|
| 64 |
my $upload_path = C4::Context->config('upload_path'); |
65 |
my $upload_path = C4::Context->config('upload_path'); |
| 65 |
my $filepath = "$upload_path/$dirname/${id}_$filename"; |
66 |
if( !-d "$upload_path/$dirname" ) { |
|
|
67 |
mkdir "$upload_path/$dirname"; |
| 68 |
} |
| 69 |
my $filepath = "$upload_path/$dirname/${hash}_$filename"; |
| 66 |
$filepath =~ s|/+|/|g; |
70 |
$filepath =~ s|/+|/|g; |
| 67 |
|
71 |
|
| 68 |
return $filepath; |
72 |
return $filepath; |
|
Lines 90-110
It returns undef if file is not found
Link Here
|
| 90 |
=cut |
94 |
=cut |
| 91 |
|
95 |
|
| 92 |
sub GetUploadedFile { |
96 |
sub GetUploadedFile { |
| 93 |
my ($id) = @_; |
97 |
my ( $hashvalue ) = @_; |
| 94 |
|
98 |
|
| 95 |
return unless $id; |
99 |
return unless $hashvalue; |
| 96 |
|
100 |
|
| 97 |
my $dbh = C4::Context->dbh; |
101 |
my $dbh = C4::Context->dbh; |
| 98 |
my $query = qq{ |
102 |
my $query = qq{ |
| 99 |
SELECT id, filename, dir |
103 |
SELECT hashvalue, filename, dir |
| 100 |
FROM uploaded_files |
104 |
FROM uploaded_files |
| 101 |
WHERE id = ? |
105 |
WHERE hashvalue = ? |
| 102 |
}; |
106 |
}; |
| 103 |
my $sth = $dbh->prepare($query); |
107 |
my $sth = $dbh->prepare($query); |
| 104 |
$sth->execute($id); |
108 |
$sth->execute( $hashvalue ); |
| 105 |
my $file = $sth->fetchrow_hashref; |
109 |
my $file = $sth->fetchrow_hashref; |
| 106 |
if ($file) { |
110 |
if ($file) { |
| 107 |
$file->{filepath} = _get_file_path($file->{id}, $file->{dir}, |
111 |
$file->{filepath} = _get_file_path($file->{hashvalue}, $file->{dir}, |
| 108 |
$file->{filename}); |
112 |
$file->{filename}); |
| 109 |
} |
113 |
} |
| 110 |
|
114 |
|
|
Lines 134-140
$cgi->upload('uploaded_file')->handle;
Link Here
|
| 134 |
|
138 |
|
| 135 |
sub UploadFile { |
139 |
sub UploadFile { |
| 136 |
my ($filename, $dir, $handle) = @_; |
140 |
my ($filename, $dir, $handle) = @_; |
| 137 |
|
|
|
| 138 |
$filename = decode_utf8($filename); |
141 |
$filename = decode_utf8($filename); |
| 139 |
if($filename =~ m#(^|/)\.\.(/|$)# or $dir =~ m#(^|/)\.\.(/|$)#) { |
142 |
if($filename =~ m#(^|/)\.\.(/|$)# or $dir =~ m#(^|/)\.\.(/|$)#) { |
| 140 |
warn "Filename or dirname contains '..'. Aborting upload"; |
143 |
warn "Filename or dirname contains '..'. Aborting upload"; |
|
Lines 152-166
sub UploadFile {
Link Here
|
| 152 |
$sha->add($data); |
155 |
$sha->add($data); |
| 153 |
$sha->add($filename); |
156 |
$sha->add($filename); |
| 154 |
$sha->add($dir); |
157 |
$sha->add($dir); |
| 155 |
my $id = $sha->hexdigest; |
158 |
my $hash = $sha->hexdigest; |
| 156 |
|
159 |
|
| 157 |
# Test if this id already exist |
160 |
# Test if this id already exist |
| 158 |
my $file = GetUploadedFile($id); |
161 |
my $file = GetUploadedFile($hash); |
| 159 |
if ($file) { |
162 |
if ($file) { |
| 160 |
return $file->{id}; |
163 |
return $file->{hashvalue}; |
| 161 |
} |
164 |
} |
| 162 |
|
165 |
|
| 163 |
my $file_path = _get_file_path($id, $dir, $filename); |
166 |
my $file_path = _get_file_path($hash, $dir, $filename); |
| 164 |
|
167 |
|
| 165 |
my $out_fh; |
168 |
my $out_fh; |
| 166 |
# Create the file only if it doesn't exist |
169 |
# Create the file only if it doesn't exist |
|
Lines 170-185
sub UploadFile {
Link Here
|
| 170 |
} |
173 |
} |
| 171 |
|
174 |
|
| 172 |
print $out_fh $data; |
175 |
print $out_fh $data; |
|
|
176 |
my $size= tell($out_fh); |
| 173 |
close $out_fh; |
177 |
close $out_fh; |
| 174 |
|
178 |
|
| 175 |
my $dbh = C4::Context->dbh; |
179 |
my $dbh = C4::Context->dbh; |
| 176 |
my $query = qq{ |
180 |
my $query = qq{ |
| 177 |
INSERT INTO uploaded_files (id, filename, dir) |
181 |
INSERT INTO uploaded_files (hashvalue, filename, filesize, dir, categorycode, owner) VALUES (?,?,?,?,?,?); |
| 178 |
VALUES (?,?, ?); |
|
|
| 179 |
}; |
182 |
}; |
| 180 |
my $sth = $dbh->prepare($query); |
183 |
my $sth = $dbh->prepare($query); |
| 181 |
if($sth->execute($id, $filename, $dir)) { |
184 |
my $uid= C4::Context->userenv? C4::Context->userenv->{number}: undef; |
| 182 |
return $id; |
185 |
# uid is null in unit test |
|
|
186 |
if($sth->execute($hash, $filename, $size, $dir, $dir, $uid)) { |
| 187 |
return $hash; |
| 183 |
} |
188 |
} |
| 184 |
|
189 |
|
| 185 |
return; |
190 |
return; |
|
Lines 192-198
sub UploadFile {
Link Here
|
| 192 |
Determine if a entry is dangling. |
197 |
Determine if a entry is dangling. |
| 193 |
|
198 |
|
| 194 |
Returns: 2 == no db entry |
199 |
Returns: 2 == no db entry |
| 195 |
1 == no file |
200 |
1 == no plain file |
| 196 |
0 == both a file and db entry. |
201 |
0 == both a file and db entry. |
| 197 |
-1 == N/A (undef id / non-file-upload URL) |
202 |
-1 == N/A (undef id / non-file-upload URL) |
| 198 |
|
203 |
|
|
Lines 230-238
sub DanglingEntry {
Link Here
|
| 230 |
|
235 |
|
| 231 |
=head2 DelUploadedFile |
236 |
=head2 DelUploadedFile |
| 232 |
|
237 |
|
| 233 |
C4::UploadedFiles::DelUploadedFile($id); |
238 |
C4::UploadedFiles::DelUploadedFile( $hash ); |
| 234 |
|
239 |
|
| 235 |
Remove a previously uploaded file, given its id. |
240 |
Remove a previously uploaded file, given its hash value. |
| 236 |
|
241 |
|
| 237 |
Returns: 1 == file deleted |
242 |
Returns: 1 == file deleted |
| 238 |
0 == file not deleted |
243 |
0 == file not deleted |
|
Lines 241-256
Returns: 1 == file deleted
Link Here
|
| 241 |
=cut |
246 |
=cut |
| 242 |
|
247 |
|
| 243 |
sub DelUploadedFile { |
248 |
sub DelUploadedFile { |
| 244 |
my ($id) = @_; |
249 |
my ( $hashval ) = @_; |
| 245 |
my $retval; |
250 |
my $retval; |
| 246 |
|
251 |
|
| 247 |
if ($id) { |
252 |
if ( $hashval ) { |
| 248 |
my $file = GetUploadedFile($id); |
253 |
my $file = GetUploadedFile( $hashval ); |
| 249 |
if($file) { |
254 |
if($file) { |
| 250 |
my $file_path = $file->{filepath}; |
255 |
my $file_path = $file->{filepath}; |
| 251 |
my $file_deleted = 0; |
256 |
my $file_deleted = 0; |
| 252 |
unless( -f $file_path ) { |
257 |
unless( -f $file_path ) { |
| 253 |
warn "Id $file->{id} is in database but not in filesystem, removing id from database"; |
258 |
warn "Id $file->{hashvalue} is in database but no plain file found, removing id from database"; |
| 254 |
$file_deleted = 1; |
259 |
$file_deleted = 1; |
| 255 |
} else { |
260 |
} else { |
| 256 |
if(unlink $file_path) { |
261 |
if(unlink $file_path) { |
|
Lines 265-274
sub DelUploadedFile {
Link Here
|
| 265 |
my $dbh = C4::Context->dbh; |
270 |
my $dbh = C4::Context->dbh; |
| 266 |
my $query = qq{ |
271 |
my $query = qq{ |
| 267 |
DELETE FROM uploaded_files |
272 |
DELETE FROM uploaded_files |
| 268 |
WHERE id = ? |
273 |
WHERE hashvalue = ? |
| 269 |
}; |
274 |
}; |
| 270 |
my $sth = $dbh->prepare($query); |
275 |
my $sth = $dbh->prepare($query); |
| 271 |
my $numrows = $sth->execute($id); |
276 |
my $numrows = $sth->execute( $hashval ); |
| 272 |
# if either a DB entry or file was deleted, |
277 |
# if either a DB entry or file was deleted, |
| 273 |
# then clearly we have a deletion. |
278 |
# then clearly we have a deletion. |
| 274 |
if ($numrows>0 || $file_deleted==1) { |
279 |
if ($numrows>0 || $file_deleted==1) { |
|
Lines 279-295
sub DelUploadedFile {
Link Here
|
| 279 |
} |
284 |
} |
| 280 |
} |
285 |
} |
| 281 |
else { |
286 |
else { |
| 282 |
warn "There was no file for id=($id)"; |
287 |
warn "There was no file for hash $hashval."; |
| 283 |
$retval = -1; |
288 |
$retval = -1; |
| 284 |
} |
289 |
} |
| 285 |
} |
290 |
} |
| 286 |
else { |
291 |
else { |
| 287 |
warn "DelUploadFile called with no id."; |
292 |
warn "DelUploadFile called without hash value."; |
| 288 |
$retval = -1; |
293 |
$retval = -1; |
| 289 |
} |
294 |
} |
| 290 |
return $retval; |
295 |
return $retval; |
| 291 |
} |
296 |
} |
| 292 |
|
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 |
|
| 293 |
=head2 httpheaders |
309 |
=head2 httpheaders |
| 294 |
|
310 |
|
| 295 |
httpheaders returns http headers for a retrievable upload |
311 |
httpheaders returns http headers for a retrievable upload |