From eca8016321691f875526a1afeefc48f08e60eb9a Mon Sep 17 00:00:00 2001 From: Julian Maurice Date: Fri, 2 Mar 2012 11:55:58 +0100 Subject: [PATCH] Bug 6874: File upload in MARC Content-Type: text/plain; charset="UTF-8" New cataloging plugin upload.pl and new system preference 'uploadPath'. upload.pl provide a way to upload files on the server and store a link (url) to it in MARC uploadPath is the absolute path on the server where the files will be stored. It's possible to have a hierarchy of directories under this path and the plugin will allow to choose in which directory to store the file. Stored value in MARC subfield looks like this: /cgi-bin/koha/opac-retrieve-file.pl?id= So both 'uploadPath' and 'OPACBaseURL' sysprefs have to be set for this plugin to work correctly Signed-off-by: Jared Camins-Esakov --- C4/Biblio.pm | 29 ++- C4/UploadedFiles.pm | 214 ++++++++++++++++++++ basket/basket.pl | 2 +- catalogue/MARCdetail.pl | 1 - catalogue/detail.pl | 2 +- cataloguing/value_builder/upload.pl | 178 ++++++++++++++++ installer/data/mysql/kohastructure.sql | 11 + installer/data/mysql/sysprefs.sql | 1 + installer/data/mysql/updatedatabase.pl | 22 ++ .../en/modules/admin/preferences/cataloguing.pref | 4 + .../en/modules/cataloguing/value_builder/upload.tt | 71 +++++++ .../value_builder/upload_delete_file.tt | 49 +++++ opac/opac-basket.pl | 2 +- opac/opac-detail.pl | 2 +- opac/opac-retrieve-file.pl | 49 +++++ 15 files changed, 626 insertions(+), 11 deletions(-) create mode 100644 C4/UploadedFiles.pm create mode 100755 cataloguing/value_builder/upload.pl create mode 100644 koha-tmpl/intranet-tmpl/prog/en/modules/cataloguing/value_builder/upload.tt create mode 100644 koha-tmpl/intranet-tmpl/prog/en/modules/cataloguing/value_builder/upload_delete_file.tt create mode 100755 opac/opac-retrieve-file.pl diff --git a/C4/Biblio.pm b/C4/Biblio.pm index f8ba099..88a6bca 100644 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -36,6 +36,7 @@ use C4::ClassSource; use C4::Charset; use C4::Linker; use C4::OAI::Sets; +use C4::UploadedFiles; use vars qw($VERSION @ISA @EXPORT); @@ -1829,7 +1830,7 @@ sub GetMarcAuthors { =head2 GetMarcUrls - $marcurls = GetMarcUrls($record,$marcflavour); + $marcurls = GetMarcUrls($record,$marcflavour,$frameworkcode); Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop. Assumes web resources (not uncommon in MARC21 to omit resource type ind) @@ -1837,15 +1838,19 @@ Assumes web resources (not uncommon in MARC21 to omit resource type ind) =cut sub GetMarcUrls { - my ( $record, $marcflavour ) = @_; + my ( $record, $marcflavour, $frameworkcode ) = @_; + + my $tagslib = &GetMarcStructure(1, $frameworkcode); + my $urltag = '856'; + my $urlsubtag = 'u'; my @marcurls; - for my $field ( $record->field('856') ) { + for my $field ( $record->field($urltag) ) { my @notes; for my $note ( $field->subfield('z') ) { push @notes, { note => $note }; } - my @urls = $field->subfield('u'); + my @urls = $field->subfield($urlsubtag); foreach my $url (@urls) { my $marcurl; if ( $marcflavour eq 'MARC21' ) { @@ -1873,8 +1878,20 @@ sub GetMarcUrls { $marcurl->{'part'} = $s3 if ($link); $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ ); } else { - $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url; - $marcurl->{'MARCURL'} = $url; + if ($tagslib->{ $urltag }->{ $urlsubtag }->{value_builder} eq "upload.pl" + and $url =~ /id=([0-9a-f]+)/) { + my $file = C4::UploadedFiles::GetUploadedFile($1); + my $text = $file ? $file->{filename} : $url; + $marcurl->{'linktext'} = $field->subfield('2') + || C4::Context->preference('URLLinkText') + || $file->{filename}; + $marcurl->{'MARCURL'} = $url; + } else { + $marcurl->{'linktext'} = $field->subfield('2') + || C4::Context->preference('URLLinkText') + || $url; + $marcurl->{'MARCURL'} = $url; + } } push @marcurls, $marcurl; } diff --git a/C4/UploadedFiles.pm b/C4/UploadedFiles.pm new file mode 100644 index 0000000..5ad5adc --- /dev/null +++ b/C4/UploadedFiles.pm @@ -0,0 +1,214 @@ +package C4::UploadedFiles; + +# Copyright 2011-2012 BibLibre +# +# 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 2 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 + +C4::UploadedFiles - Functions to deal with files uploaded with cataloging plugin upload.pl + +=head1 SYNOPSIS + + use C4::UploadedFiles; + + my $filename = $cgi->param('uploaded_file'); + my $file = $cgi->upload('uploaded_file'); + my $dir = $input->param('dir'); + + # upload file + my $id = C4::UploadedFiles::UploadFile($filename, $dir, $file->handle); + + # retrieve file infos + my $uploaded_file = C4::UploadedFiles::GetUploadedFile($id); + + # delete file + C4::UploadedFiles::DelUploadedFile($id); + +=head1 DESCRIPTION + +This module provides basic functions for adding, retrieving and deleting files related to +cataloging plugin upload.pl. + +It uses uploaded_files table. + +It is not related to C4::UploadedFile + +=head1 FUNCTIONS + +=cut + +use Modern::Perl; +use Digest::SHA; +use Fcntl; + +use C4::Context; + +=head2 GetUploadedFile + + my $file = C4::UploadedFiles::GetUploadedFile($id); + +Returns a hashref containing infos on uploaded files. +Hash keys are: + +=over 2 + +=item * id: id of the file (same as given in argument) + +=item * filename: name of the file + +=item * dir: directory where file is stored (relative to syspref 'uploadPath') + +=back + +It returns undef if file is not found + +=cut + +sub GetUploadedFile { + my ($id) = @_; + + return unless $id; + + my $dbh = C4::Context->dbh; + my $query = qq{ + SELECT id, filename, dir + FROM uploaded_files + WHERE id = ? + }; + my $sth = $dbh->prepare($query); + $sth->execute($id); + my $file = $sth->fetchrow_hashref; + + return $file; +} + +=head2 UploadFile + + my $id = C4::UploadedFiles::UploadFile($filename, $dir, $io_handle); + +Upload a new file and returns its id (its SHA-1 sum, actually). + +Parameters: + +=over 2 + +=item * $filename: name of the file + +=item * $dir: directory where to store the file (path relative to syspref 'uploadPath' + +=item * $io_handle: valid IO::Handle object, can be retrieved with +$cgi->upload('uploaded_file')->handle; + +=back + +=cut + +sub UploadFile { + my ($filename, $dir, $handle) = @_; + + if($filename =~ m#/(^|/)\.\.(/|$)# or $dir =~ m#(^|/)\.\.(/|$)#) { + warn "Filename or dirname contains '..'. Aborting upload"; + return; + } + + my $buffer; + my $data = ''; + while($handle->read($buffer, 1024)) { + $data .= $buffer; + } + $handle->close; + + my $sha = new Digest::SHA; + $sha->add($data); + my $id = $sha->hexdigest; + + # Test if this id already exist + my $file = GetUploadedFile($id); + if($file) { + return $file->{id}; + } + + my $upload_path = C4::Context->preference("uploadPath"); + my $file_path = "$upload_path/$dir/$filename"; + $file_path =~ s#/+#/#; + + my $out_fh; + # Create the file only if it doesn't exist + unless( sysopen($out_fh, $file_path, O_WRONLY|O_CREAT|O_EXCL) ) { + warn "Failed to open file '$file_path': $!"; + return; + } + + print $out_fh $data; + close $out_fh; + + my $dbh = C4::Context->dbh; + my $query = qq{ + INSERT INTO uploaded_files (id, filename, dir) + VALUES (?,?, ?); + }; + my $sth = $dbh->prepare($query); + if($sth->execute($id, $filename, $dir)) { + return $id; + } + + return undef; +} + +=head2 DelUploadedFile + + C4::UploadedFiles::DelUploadedFile($id); + +Remove a previously uploaded file, given its id. + +Returns a false value if an error occurs. + +=cut + +sub DelUploadedFile { + my ($id) = @_; + + my $file = GetUploadedFile($id); + if($file) { + my $upload_path = C4::Context->preference("uploadPath"); + my $file_path = "$upload_path/$file->{dir}/$file->{filename}"; + $file_path =~ s#/+#/#; + my $file_deleted = 0; + unless( -f $file_path ) { + warn "Id $file->{id} is in database but not in filesystem, removing id from database"; + $file_deleted = 1; + } else { + if(unlink $file_path) { + $file_deleted = 1; + } + } + + unless($file_deleted) { + warn "File $file_path cannot be deleted: $!"; + } + + my $dbh = C4::Context->dbh; + my $query = qq{ + DELETE FROM uploaded_files + WHERE id = ? + }; + my $sth = $dbh->prepare($query); + return $sth->execute($id); + } +} + +1; diff --git a/basket/basket.pl b/basket/basket.pl index 8fc15e4..59894b3 100755 --- a/basket/basket.pl +++ b/basket/basket.pl @@ -65,7 +65,7 @@ foreach my $biblionumber ( @bibs ) { my $marcauthorsarray = GetMarcAuthors( $record, $marcflavour ); my $marcsubjctsarray = GetMarcSubjects( $record, $marcflavour ); my $marcseriesarray = GetMarcSeries ($record,$marcflavour); - my $marcurlsarray = GetMarcUrls ($record,$marcflavour); + my $marcurlsarray = GetMarcUrls ($record,$marcflavour, GetFrameworkCode($biblionumber)); my @items = GetItemsInfo( $biblionumber ); my $hasauthors = 0; diff --git a/catalogue/MARCdetail.pl b/catalogue/MARCdetail.pl index 0490076..529ac59 100755 --- a/catalogue/MARCdetail.pl +++ b/catalogue/MARCdetail.pl @@ -215,7 +215,6 @@ for ( my $tabloop = 0 ; $tabloop <= 10 ; $tabloop++ ) { $subfield_data{marc_value} = GetAuthorisedValueDesc( $fields[$x_i]->tag(), $subf[$i][0], $subf[$i][1], '', $tagslib) || $subf[$i][1]; - } $subfield_data{marc_subfield} = $subf[$i][0]; $subfield_data{marc_tag} = $fields[$x_i]->tag(); diff --git a/catalogue/detail.pl b/catalogue/detail.pl index d110740..86f3b47 100755 --- a/catalogue/detail.pl +++ b/catalogue/detail.pl @@ -111,7 +111,7 @@ my $marcisbnsarray = GetMarcISBN( $record, $marcflavour ); my $marcauthorsarray = GetMarcAuthors( $record, $marcflavour ); my $marcsubjctsarray = GetMarcSubjects( $record, $marcflavour ); my $marcseriesarray = GetMarcSeries($record,$marcflavour); -my $marcurlsarray = GetMarcUrls ($record,$marcflavour); +my $marcurlsarray = GetMarcUrls ($record, $marcflavour, $fw); my $marchostsarray = GetMarcHosts($record,$marcflavour); my $subtitle = GetRecordValue('subtitle', $record, $fw); diff --git a/cataloguing/value_builder/upload.pl b/cataloguing/value_builder/upload.pl new file mode 100755 index 0000000..0cb33f4 --- /dev/null +++ b/cataloguing/value_builder/upload.pl @@ -0,0 +1,178 @@ +#!/usr/bin/perl + +# Copyright 2011-2012 BibLibre +# +# 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 2 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. + +use Modern::Perl; +use CGI qw/-utf8/; +use File::Basename; + +use C4::Auth; +use C4::Context; +use C4::Output; +use C4::UploadedFiles; + +my $upload_path = C4::Context->preference('uploadPath'); + +sub plugin_parameters { + my ( $dbh, $record, $tagslib, $i, $tabloop ) = @_; + return ""; +} + +sub plugin_javascript { + my ( $dbh, $record, $tagslib, $field_number, $tabloop ) = @_; + my $function_name = $field_number; + my $res = " + +"; + + return ( $function_name, $res ); +} + +sub plugin { + my ($input) = @_; + my $index = $input->param('index'); + my $id = $input->param('id'); + my $delete = $input->param('delete'); + my $uploaded_file = $input->param('uploaded_file'); + + my $template_name = ($id || $delete) + ? "upload_delete_file.tt" + : "upload.tt"; + + my ( $template, $loggedinuser, $cookie ) = get_template_and_user( + { template_name => "cataloguing/value_builder/$template_name", + query => $input, + type => "intranet", + authnotrequired => 0, + flagsrequired => { editcatalogue => '*' }, + debug => 1, + } + ); + + # Dealing with the uploaded file + if ($uploaded_file) { + my $fh = $input->upload('uploaded_file'); + my $dir = $input->param('dir'); + + $id = C4::UploadedFiles::UploadFile($uploaded_file, $dir, $fh->handle); + if($id) { + my $OPACBaseURL = C4::Context->preference('OPACBaseURL'); + $OPACBaseURL =~ s#/$##; + my $return = "$OPACBaseURL/cgi-bin/koha/opac-retrieve-file.pl?id=$id"; + $template->param( + success => 1, + return => $return, + uploaded_file => $uploaded_file, + ); + } else { + $template->param(error => 1); + } + } elsif ($delete || $id) { + # If there's already a file uploaded for this field, + # We handle its deletion + if ($delete) { + if(C4::UploadedFiles::DelUploadedFile($id)) {; + $template->param(success => 1); + } else { + $template->param(error => 1); + } + } + } else { + my $filefield = CGI::filefield( + -name => 'uploaded_file', + -size => 50, + ); + + my $dirs_tree = [ { + name => '/', + value => '/', + dirs => finddirs($upload_path) + } ]; + + $template->param( + dirs_tree => $dirs_tree, + filefield => $filefield + ); + } + + $template->param( + index => $index, + id => $id + ); + + output_html_with_http_headers $input, $cookie, $template->output; +} + +# Build a hierarchy of directories +sub finddirs { + my $base = shift || $upload_path; + my $found = 0; + my @dirs; + my @files = <$base/*>; + foreach (@files) { + if (-d $_ and -w $_) { + my $lastdirname = basename($_); + my $dirname = $_; + $dirname =~ s/^$upload_path//g; + push @dirs, { + value => $dirname, + name => $lastdirname, + dirs => finddirs($_) + }; + $found = 1; + }; + } + return \@dirs; +} + +1; + + +__END__ + +=head1 upload.pl + +This plugin allow to upload files on the server and reference it in a marc +field. + +Two system preference are used: + +=over 4 + +=item * uploadPath: the real absolute path where files will be stored + +=item * OPACBaseURL: for building URLs to be stored in MARC + +=back diff --git a/installer/data/mysql/kohastructure.sql b/installer/data/mysql/kohastructure.sql index 593c404..f23264fc 100644 --- a/installer/data/mysql/kohastructure.sql +++ b/installer/data/mysql/kohastructure.sql @@ -2862,6 +2862,17 @@ CREATE TABLE `quotes` ( PRIMARY KEY (`id`) ) ENGINE=InnoDB DEFAULT CHARSET=utf8; +-- +-- Table structure for table uploaded_files +-- + +DROP TABLE IF EXISTS uploaded_files +CREATE TABLE uploaded_files ( + id CHAR(40) NOT NULL PRIMARY KEY, + filename TEXT NOT NULL, + dir TEXT NOT NULL +) ENGINE=InnoDB DEFAULT CHARSET=utf8; + /*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */; /*!40101 SET SQL_MODE=@OLD_SQL_MODE */; /*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */; diff --git a/installer/data/mysql/sysprefs.sql b/installer/data/mysql/sysprefs.sql index 6a3735d..c048059 100644 --- a/installer/data/mysql/sysprefs.sql +++ b/installer/data/mysql/sysprefs.sql @@ -375,3 +375,4 @@ INSERT INTO systempreferences (variable,value,options,explanation,type) VALUES ( INSERT INTO systempreferences (variable,value,explanation,type) VALUES('EnableBorrowerFiles','0','If enabled, allows librarians to upload and attach arbitrary files to a borrower record.','YesNo'); INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES('UpdateTotalIssuesOnCirc','0','Whether to update the totalissues field in the biblio on each circ.',NULL,'YesNo'); +INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES ('uploadPath','','Sets the upload path for the upload.pl plugin. For security reasons, the upload path MUST NOT be a public, webserver accessible directory.','',''); diff --git a/installer/data/mysql/updatedatabase.pl b/installer/data/mysql/updatedatabase.pl index 97a722e..5c47558 100755 --- a/installer/data/mysql/updatedatabase.pl +++ b/installer/data/mysql/updatedatabase.pl @@ -5459,6 +5459,28 @@ if (C4::Context->preference("Version") < TransformToNum($DBversion)) { SetVersion($DBversion); } +$DBversion = "XXX"; +if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) { + $dbh->do(" + INSERT IGNORE INTO systempreferences (variable,value,explanation,options,type) + VALUES('uploadPath','','Sets the upload path for the upload.pl plugin','',''); + "); + + $dbh->do(" + CREATE TABLE uploaded_files ( + id CHAR(40) NOT NULL PRIMARY KEY, + filename TEXT NOT NULL, + dir TEXT NOT NULL + ) ENGINE=InnoDB DEFAULT CHARSET=utf8; + "); + + print "Upgrade to $DBversion done (New cataloging plugin upload.pl)\n"; + print "This plugin comes with a new syspref (uploadPath) and a new table (uploaded_files)\n"; + print "To use it, set 'uploadPath' and 'OPACBaseURL' system preferences and link this plugin to a subfield (856\$u for instance)\n"; + SetVersion($DBversion); +} + + =head1 FUNCTIONS =head2 TableExists($table) diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref index fe5fd05..f052a46 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref @@ -94,6 +94,10 @@ Cataloging: annual: generated in the form <year>-0001, <year>-0002. hbyymmincr: generated in the form <branchcode>yymm0001. "OFF": not generated automatically. + - + - Absolute path where to store files uploaded in MARC record (plugin upload.pl) + - pref: uploadPath + class: multi Display: - - 'Separate multiple displayed authors, series or subjects with ' diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/cataloguing/value_builder/upload.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/cataloguing/value_builder/upload.tt new file mode 100644 index 0000000..4fae58a --- /dev/null +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/cataloguing/value_builder/upload.tt @@ -0,0 +1,71 @@ + + + + Upload plugin + + + + + + +[% IF ( success ) %] + + + + + The file [% uploaded_file | html %] has been successfully uploaded. +

+ +[% ELSE %] + + [% IF ( error ) %] +

Error: Failed to upload file. See logs for details.

+ + [% ELSE %] + [%# This block display recursively a directory tree in variable 'dirs' %] + [% BLOCK list_dirs %] + [% IF dirs.size %] +
    + [% FOREACH dir IN dirs %] +
  • + + + + [% INCLUDE list_dirs dirs=dir.dirs %] +
  • + [% END %] +
+ [% END %] + [% END %] + +

Please select the file to upload :

+
+ [% filefield %] +

Choose where to upload file

+ [% INCLUDE list_dirs dirs = dirs_tree %] + + + +
+ [% END %] + +[% END %] + + + diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/cataloguing/value_builder/upload_delete_file.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/cataloguing/value_builder/upload_delete_file.tt new file mode 100644 index 0000000..2da616e --- /dev/null +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/cataloguing/value_builder/upload_delete_file.tt @@ -0,0 +1,49 @@ + + + + Upload plugin + + + + + + +[% IF ( success ) %] + + + + The file has been successfully deleted. +

+ +[% ELSE %] + + [% IF ( error ) %] + Error: Unable to delete the file. +

+ [% ELSE %] +

File deletion

+

A file has already been uploaded for this field. Do you want to delete it?

+
+ + + + + + +
+ [% END %] + +[% END %] + + + diff --git a/opac/opac-basket.pl b/opac/opac-basket.pl index cf75eb7..cac3e13 100755 --- a/opac/opac-basket.pl +++ b/opac/opac-basket.pl @@ -69,7 +69,7 @@ foreach my $biblionumber ( @bibs ) { my $marcauthorsarray = GetMarcAuthors( $record, $marcflavour ); my $marcsubjctsarray = GetMarcSubjects( $record, $marcflavour ); my $marcseriesarray = GetMarcSeries ($record,$marcflavour); - my $marcurlsarray = GetMarcUrls ($record,$marcflavour); + my $marcurlsarray = GetMarcUrls ($record,$marcflavour, GetFrameworkCode($biblionumber)); my @items = &GetItemsInfo( $biblionumber ); my $subtitle = GetRecordValue('subtitle', $record, GetFrameworkCode($biblionumber)); diff --git a/opac/opac-detail.pl b/opac/opac-detail.pl index 0bafabd..a19cddb 100755 --- a/opac/opac-detail.pl +++ b/opac/opac-detail.pl @@ -576,7 +576,7 @@ my $marcisbnsarray = GetMarcISBN ($record,$marcflavour); my $marcauthorsarray = GetMarcAuthors ($record,$marcflavour); my $marcsubjctsarray = GetMarcSubjects($record,$marcflavour); my $marcseriesarray = GetMarcSeries ($record,$marcflavour); -my $marcurlsarray = GetMarcUrls ($record,$marcflavour); +my $marcurlsarray = GetMarcUrls ($record, $marcflavour, $dat->{'frameworkcode'}); my $marchostsarray = GetMarcHosts($record,$marcflavour); my $subtitle = GetRecordValue('subtitle', $record, GetFrameworkCode($biblionumber)); diff --git a/opac/opac-retrieve-file.pl b/opac/opac-retrieve-file.pl new file mode 100755 index 0000000..9904199 --- /dev/null +++ b/opac/opac-retrieve-file.pl @@ -0,0 +1,49 @@ +#!/usr/bin/perl + +# Copyright 2011-2012 BibLibre +# +# 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 2 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. + +use Modern::Perl; +use CGI; + +use C4::Context; +use C4::UploadedFiles; + +my $input = new CGI; + +my $id = $input->param('id'); +my $file = C4::UploadedFiles::GetUploadedFile($id); +exit 1 if not $file; + +my $upload_path = C4::Context->preference("uploadPath"); +my $file_path = "$upload_path/$file->{dir}/$file->{filename}"; +$file_path =~ s#/+#/#; + +if( -f $file_path ) { + open FH, '<', $file_path or die "Can't open file: $!"; + print $input->header( + -type => "application/octet-stream", + -attachment => $file->{filename} + ); + while() { + print $_; + } +} else { + exit 1; +} + +exit 0; -- 1.7.2.5