package Koha::Upload;

# 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, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

=head1 NAME

Koha::Upload - Facilitate file uploads (temporary and permanent)

=head1 SYNOPSIS

    use Koha::Upload;

    # add an upload (see tools/upload-file.pl)
    # the public flag allows retrieval via OPAC
    my $upload = Koha::Upload->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)
    # Note: use the public flag for OPAC
    my @uploads = Koha::Upload->new->get( term => $term );
    $template->param( uploads => \@uploads );

    # staff download
    my $rec = Koha::Upload->new->get({ id => $id, filehandle => 1 });
    my $fh = $rec->{fh};
    my @hdr = Koha::Upload->httpheaders( $rec->{name} );
    print Encode::encode_utf8( $input->header( @hdr ) );
    while( <$fh> ) { print $_; }
    $fh->close;

    # delete an upload
    my ( $fn ) = Koha::Upload->new->delete({ id => $id });

=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.

=head1 METHODS

=cut

use constant KOHA_UPLOAD => 'koha_upload';
use constant BYTES_DIGEST => 2048;

use Modern::Perl;
use CGI; # no utf8 flag, since it may interfere with binary uploads
use Digest::MD5;
use Encode;
use File::Spec;
use IO::File;
use Time::HiRes;

use base qw(Class::Accessor);

use C4::Context;
use C4::Koha;

__PACKAGE__->mk_ro_accessors( qw|| );

=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 hash with errors in format { file => 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 } = $e if $e;
    }
    return $err;
}

=head2 get

    Returns arrayref of uploaded records (hash) or one uploaded record.
    You can pass id => $id or hashvalue => $hash or term => $term.
    Optional parameter filehandle => 1 returns you a filehandle too.

=cut

sub get {
    my ( $self, $params ) = @_;
    my $temp= $self->_lookup( $params );
    my ( @rv, $res);
    foreach my $r ( @$temp ) {
        undef $res;
        foreach( qw[id hashvalue filesize uploadcategorycode public permanent] ) {
            $res->{$_} = $r->{$_};
        }
        $res->{name} = $r->{filename};
        $res->{path} = $self->_full_fname($r);
        if( $res->{path} && -r $res->{path} ) {
            if( $params->{filehandle} ) {
                my $fh = IO::File->new( $res->{path}, "r" );
                $fh->binmode if $fh;
                $res->{fh} = $fh;
            }
            push @rv, $res;
        } else {
            $self->{files}->{ $r->{filename} }->{errcode}=5; #not readable
        }
        last if !wantarray;
    }
    return wantarray? @rv: $res;
}

=head2 delete

    Returns array of deleted filenames or undef.
    Since it now only accepts id as parameter, you should not expect more
    than one filename.

=cut

sub delete {
    my ( $self, $params ) = @_;
    return if !$params->{id};
    my @res;
    my $temp = $self->_lookup({ id => $params->{id} });
    foreach( @$temp ) {
        my $d = $self->_delete( $_ );
        push @res, $d if $d;
    }
    return if !@res;
    return @res;
}

=head1 CLASS METHODS

=head2 getCategories

    getCategories returns a list of upload category codes and names

=cut

sub getCategories {
    my ( $class ) = @_;
    my $cats = C4::Koha::GetAuthorisedValues('UPLOAD');
    [ map {{ code => $_->{authorised_value}, name => $_->{lib} }} @$cats ];
}

=head2 httpheaders

    httpheaders returns http headers for a retrievable upload
    Will be extended by report 14282

=cut

sub httpheaders {
    my ( $class, $name ) = @_;
    return (
        '-type'       => 'application/octet-stream',
        '-attachment' => $name,
    );
}

=head1 INTERNAL ROUTINES

=cut

sub _init {
    my ( $self, $params ) = @_;

    $self->{rootdir} = C4::Context->config('upload_path');
    $self->{tmpdir} = File::Spec->tmpdir;

    $params->{tmp} = $params->{temp} if !exists $params->{tmp};
    $self->{temporary} = $params->{tmp}? 1: 0; #default false
    $self->{category} = $params->{tmp}? KOHA_UPLOAD:
        ( $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} = 3; #no rootdir
    } elsif( $self->{temporary} && !$self->{tmpdir} ) {
        $self->{files}->{$filename}->{errcode} = 4; #no tempdir
    } else {
        my $dir = $self->_dir;
        my $fn = $self->{files}->{$filename}->{hash}. '_'. $filename;
        if( -e "$dir/$fn" && @{ $self->_lookup({
          hashvalue => $self->{files}->{$filename}->{hash} }) } ) {
        # if the file exists and it is registered, then set error
            $self->{files}->{$filename}->{errcode} = 1; #already exists
            return;
        }
        $fh = IO::File->new( "$dir/$fn", "w");
        if( $fh ) {
            $fh->binmode;
            $self->{files}->{$filename}->{fh}= $fh;
        } else {
            $self->{files}->{$filename}->{errcode} = 2; #not writable
        }
    }
    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 _full_fname {
    my ( $self, $rec ) = @_;
    my $p;
    if( ref $rec ) {
        $p = File::Spec->catfile(
            $rec->{permanent}? $self->{rootdir}: $self->{tmpdir},
            $rec->{dir},
            $rec->{hashvalue}. '_'. $rec->{filename}
        );
    }
    return $p;
}

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 $dbh= C4::Context->dbh;
    my $sql= 'INSERT INTO uploaded_files (hashvalue, filename, dir, filesize,
        owner, uploadcategorycode, public, permanent) VALUES (?,?,?,?,?,?,?,?)';
    my @pars= (
        $self->{files}->{$filename}->{hash},
        $filename,
        $self->{category},
        $size,
        $self->{uid},
        $self->{category},
        $self->{public},
        $self->{temporary}? 0: 1,
    );
    $dbh->do( $sql, undef, @pars );
    my $i = $dbh->last_insert_id(undef, undef, 'uploaded_files', undef);
    $self->{files}->{$filename}->{id} = $i if $i;
}

sub _lookup {
    my ( $self, $params ) = @_;
    my $dbh = C4::Context->dbh;
    my $sql = q|
SELECT id,hashvalue,filename,dir,filesize,uploadcategorycode,public,permanent
FROM uploaded_files
    |;
    my @pars;
    if( $params->{id} ) {
        return [] if $params->{id} !~ /^\d+(,\d+)*$/;
        $sql.= 'WHERE id IN ('.$params->{id}.')';
        @pars = ();
    } elsif( $params->{hashvalue} ) {
        $sql.= 'WHERE hashvalue=?';
        @pars = ( $params->{hashvalue} );
    } elsif( $params->{term} ) {
        $sql.= 'WHERE (filename LIKE ? OR hashvalue LIKE ?)';
        @pars = ( '%'.$params->{term}.'%', '%'.$params->{term}.'%' );
    } else {
        return [];
    }
    $sql.= $self->{public}? ' AND public=1': '';
    $sql.= ' ORDER BY id';
    my $temp= $dbh->selectall_arrayref( $sql, { Slice => {} }, @pars );
    return $temp;
}

sub _delete {
    my ( $self, $rec ) = @_;
    my $dbh = C4::Context->dbh;
    my $sql = 'DELETE FROM uploaded_files WHERE id=?';
    my $file = $self->_full_fname($rec);
    if( !-e $file ) { # we will just delete the record
        # TODO Should we add a trace here for the missing file?
        $dbh->do( $sql, undef, ( $rec->{id} ) );
        return $rec->{filename};
    } elsif( unlink($file) ) {
        $dbh->do( $sql, undef, ( $rec->{id} ) );
        return $rec->{filename};
    }
    $self->{files}->{ $rec->{filename} }->{errcode} = 7;
    #NOTE: errcode=6 is used to report successful delete (see template)
    return;
}

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;