Koha/Koha/Uploader.pm
Jonathan Druart e53667105d Bug 29844: Fix ->search occurrences
and some more...

There are lot of inconsistencies in our ->search calls. We could
simplify some of them, but not in this patch. Here we want to prevent
regressions as much as possible and so don't add unecessary changes.

Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>
Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>
Signed-off-by: Fridolin Somers <fridolin.somers@biblibre.com>
2022-02-09 15:36:23 -10:00

320 lines
9 KiB
Perl

package Koha::Uploader;
# Copyright 2007 LibLime, Galen Charlton
# Copyright 2011-2012 BibLibre
# Copyright 2015 Rijksmuseum
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.
=head1 NAME
Koha::Uploader - Facilitate file uploads (temporary and permanent)
=head1 SYNOPSIS
use Koha::Uploader;
use Koha::UploadedFile;
use Koha::UploadedFiles;
# add an upload (see tools/upload-file.pl)
# the public flag allows retrieval via OPAC
my $upload = Koha::Uploader->new( public => 1, category => 'A' );
my $cgi = $upload->cgi;
# Do something with $upload->count, $upload->result or $upload->err
# get some upload records (in staff) via Koha::UploadedFiles
my $uploads1 = Koha::UploadedFiles->search({ filename => $name });
my $uploads2 = Koha::UploadedFiles->search_term({ term => $term });
# staff download (via Koha::UploadedFile[s])
my $rec = Koha::UploadedFiles->find( $id );
my $fh = $rec->file_handle;
print Encode::encode_utf8( $input->header( $rec->httpheaders ) );
while( <$fh> ) { print $_; }
$fh->close;
=head1 DESCRIPTION
This module is a refactored version of C4::UploadedFile but adds on top
of that the new functions from report 6874 (Upload plugin in editor).
That report added module UploadedFiles.pm. This module contains the
functionality of both.
The module has been revised to use Koha::Object[s]; the delete method
has been moved to Koha::UploadedFile[s], as well as the get method.
=cut
use constant KOHA_UPLOAD => 'koha_upload';
use constant BYTES_DIGEST => 2048;
use constant ERR_EXISTS => 'UPLERR_ALREADY_EXISTS';
use constant ERR_PERMS => 'UPLERR_CANNOT_WRITE';
use constant ERR_ROOT => 'UPLERR_NO_ROOT_DIR';
use constant ERR_TEMP => 'UPLERR_NO_TEMP_DIR';
use Modern::Perl;
use CGI; # no utf8 flag, since it may interfere with binary uploads
use Digest::MD5;
use Encode;
use IO::File;
use Time::HiRes;
use base qw(Class::Accessor);
use C4::Context;
use C4::Koha;
use Koha::UploadedFile;
use Koha::UploadedFiles;
__PACKAGE__->mk_ro_accessors( qw|| );
=head1 INSTANCE METHODS
=head2 new
Returns new object based on Class::Accessor.
Use tmp or temp flag for temporary storage.
Use public flag to mark uploads as available in OPAC.
The category parameter is only useful for permanent storage.
=cut
sub new {
my ( $class, $params ) = @_;
my $self = $class->SUPER::new();
$self->_init( $params );
return $self;
}
=head2 cgi
Returns CGI object. The CGI hook is used to store the uploaded files.
=cut
sub cgi {
my ( $self ) = @_;
# Next call handles the actual upload via CGI hook.
# The third parameter (0) below means: no CGI temporary storage.
# Cancelling an upload will make CGI abort the script; no problem,
# the file(s) without db entry will be removed later.
my $query = CGI::->new( sub { $self->_hook(@_); }, {}, 0 );
if( $query ) {
$self->_done;
return $query;
}
}
=head2 count
Returns number of uploaded files without errors
=cut
sub count {
my ( $self ) = @_;
return scalar grep { !exists $self->{files}->{$_}->{errcode} } keys %{ $self->{files} };
}
=head2 result
Returns a string of id's for each successful upload separated by commas.
=cut
sub result {
my ( $self ) = @_;
my @a = map { $self->{files}->{$_}->{id} }
grep { !exists $self->{files}->{$_}->{errcode} }
keys %{ $self->{files} };
return @a? ( join ',', @a ): undef;
}
=head2 err
Returns hashref with errors in format { file => { code => err }, ... }
Undefined if there are no errors.
=cut
sub err {
my ( $self ) = @_;
my $err;
foreach my $f ( keys %{ $self->{files} } ) {
my $e = $self->{files}->{$f}->{errcode};
$err->{ $f }->{code} = $e if $e;
}
return $err;
}
=head1 CLASS METHODS
=head2 allows_add_by
allows_add_by checks if $userid has permission to add uploaded files
=cut
sub allows_add_by {
my ( $class, $userid ) = @_; # do not confuse with borrowernumber
my $flags = [
{ tools => 'upload_general_files' },
{ circulate => 'circulate_remaining_permissions' },
{ tools => 'stage_marc_import' },
{ tools => 'upload_local_cover_images' },
];
require C4::Auth;
foreach( @$flags ) {
return 1 if C4::Auth::haspermission( $userid, $_ );
}
return;
}
=head1 INTERNAL ROUTINES
=cut
sub _init {
my ( $self, $params ) = @_;
$self->{rootdir} = Koha::UploadedFile->permanent_directory;
$self->{tmpdir} = C4::Context::temporary_directory;
$params->{tmp} = $params->{temp} if !exists $params->{tmp};
$self->{temporary} = $params->{tmp}? 1: 0; #default false
if( $params->{tmp} ) {
my $db = C4::Context->config('database');
$self->{category} = KOHA_UPLOAD;
$self->{category} =~ s/koha/$db/;
} else {
$self->{category} = $params->{category} || KOHA_UPLOAD;
}
$self->{files} = {};
$self->{uid} = C4::Context->userenv->{number} if C4::Context->userenv;
$self->{public} = $params->{public}? 1: undef;
}
sub _fh {
my ( $self, $filename ) = @_;
if( $self->{files}->{$filename} ) {
return $self->{files}->{$filename}->{fh};
}
}
sub _create_file {
my ( $self, $filename ) = @_;
my $fh;
if( $self->{files}->{$filename} &&
$self->{files}->{$filename}->{errcode} ) {
#skip
} elsif( !$self->{temporary} && !$self->{rootdir} ) {
$self->{files}->{$filename}->{errcode} = ERR_ROOT; #no rootdir
} elsif( $self->{temporary} && !$self->{tmpdir} ) {
$self->{files}->{$filename}->{errcode} = ERR_TEMP; #no tempdir
} else {
my $dir = $self->_dir;
my $hashval = $self->{files}->{$filename}->{hash};
my $fn = $hashval. '_'. $filename;
# if the file exists and it is registered, then set error
# if it exists, but is not in the database, we will overwrite
if( -e "$dir/$fn" &&
Koha::UploadedFiles->search({
hashvalue => $hashval,
uploadcategorycode => $self->{category},
})->count ) {
$self->{files}->{$filename}->{errcode} = ERR_EXISTS;
return;
}
$fh = IO::File->new( "$dir/$fn", "w");
if( $fh ) {
$fh->binmode;
$self->{files}->{$filename}->{fh}= $fh;
} else {
$self->{files}->{$filename}->{errcode} = ERR_PERMS;
}
}
return $fh;
}
sub _dir {
my ( $self ) = @_;
my $dir = $self->{temporary}? $self->{tmpdir}: $self->{rootdir};
$dir.= '/'. $self->{category};
mkdir $dir if !-d $dir;
return $dir;
}
sub _hook {
my ( $self, $filename, $buffer, $bytes_read, $data ) = @_;
$filename= Encode::decode_utf8( $filename ); # UTF8 chars in filename
$self->_compute( $filename, $buffer );
my $fh = $self->_fh( $filename ) // $self->_create_file( $filename );
print $fh $buffer if $fh;
}
sub _done {
my ( $self ) = @_;
$self->{done} = 1;
foreach my $f ( keys %{ $self->{files} } ) {
my $fh = $self->_fh($f);
$self->_register( $f, $fh? tell( $fh ): undef )
if !$self->{files}->{$f}->{errcode};
$fh->close if $fh;
}
}
sub _register {
my ( $self, $filename, $size ) = @_;
my $rec = Koha::UploadedFile->new({
hashvalue => $self->{files}->{$filename}->{hash},
filename => $filename,
dir => $self->{category},
filesize => $size,
owner => $self->{uid},
uploadcategorycode => $self->{category},
public => $self->{public},
permanent => $self->{temporary}? 0: 1,
})->store;
$self->{files}->{$filename}->{id} = $rec->id if $rec;
}
sub _compute {
# Computes hash value when sub hook feeds the first block
# For temporary files, the id is made unique with time
my ( $self, $name, $block ) = @_;
if( !$self->{files}->{$name}->{hash} ) {
my $str = $name. ( $self->{uid} // '0' ).
( $self->{temporary}? Time::HiRes::time(): '' ).
$self->{category}. substr( $block, 0, BYTES_DIGEST );
# since Digest cannot handle wide chars, we need to encode here
# there could be a wide char in the filename or the category
my $h = Digest::MD5::md5_hex( Encode::encode_utf8( $str ) );
$self->{files}->{$name}->{hash} = $h;
}
}
=head1 AUTHOR
Koha Development Team
Larger parts from Galen Charlton, Julian Maurice and Marcel de Rooy
=cut
1;