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 %] +Configuration variable 'upload_path' is not configured.
+Please configure it in your koha-conf.xml
+ [% ELSE %] +The file has been successfully deleted.
+ + + + +[% ELSE %] + + [% IF ( error ) %] + Error: Unable to delete the file. + + [% ELSE %] +A file has already been uploaded for this field. Do you want to delete it?
+ + [% END %] + +[% END %] + + + --- a/misc/strip_value_from_tag.pl +++ a/misc/strip_value_from_tag.pl @@ -0,0 +1,60 @@ +#!/usr/bin/perl + +# This script takes every biblio record in the database, +# looks for a value beginning with $find in $fieldtag$$subfieldtag +# and strips $find from this value. +# This was originally made for the file upload plugin, but might +# be used for other purposes. + +use Modern::Perl; + +use Getopt::Long; +use C4::Context; +use C4::Biblio; + +my $debug = 0; + +# Which field are we processing? +my $fieldtag = "857"; +my $subfieldtag = "u"; + +# Whichi beginning pattern are we looking to delete? +my $find = "http://myurl.tld/"; +my $length = length($find); +my $pattern = qr|^$find|; + +print "Field $fieldtag\$$subfieldtag\n"; + +# Getting db connection +my $dbh = C4::Context->dbh; + +# Getting max bibnumber +my $query = "SELECT MAX(biblionumber) from biblio"; +my $sth = $dbh->prepare($query); +$sth->execute(); +my $bibliocount = $sth->fetchrow; + +warn "unable to get biblio count" and exit -1 unless $bibliocount; + +print "Biblio count : $bibliocount\n"; + +# Foreach each biblio +foreach (1..$bibliocount) { + my $found = 0; + my $record = GetMarcBiblio($_); + $debug and warn "unable to get marc for record $_" unless $record; + next unless $record; + foreach my $field ($record->field($fieldtag)) { + my $newfield = $field->clone(); + my $subfield = $newfield->subfield($subfieldtag); + if ($subfield and $subfield =~ $pattern) { + my $newsubfield = substr $subfield, $length; + $newsubfield =~ s/\s+$//; + $newfield->update($subfieldtag, $newsubfield); + $field->replace_with($newfield); + $found = 1; + } + } + print "processing $_\n" if ($found == 1); + ModBiblioMarc($record, $_, GetFrameworkCode($_)) if ($found == 1); +} --- a/opac/opac-basket.pl +++ a/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)); --- a/opac/opac-detail.pl +++ a/opac/opac-detail.pl @@ -634,7 +634,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)); --- a/opac/opac-retrieve-file.pl +++ a/opac/opac-retrieve-file.pl @@ -0,0 +1,50 @@ +#!/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 $file_path = $file->{filepath}; + +if( -f $file_path ) { + open my $fh, '<', $file_path or die "Can't open file: $!"; + print $input->header( + -type => "application/octet-stream", + -attachment => $file->{filename} + ); + while(<$fh>) { + print $_; + } +} else { + exit 1; +} + +exit 0; --- a/t/db_dependent/UploadedFiles.t +++ a/t/db_dependent/UploadedFiles.t @@ -0,0 +1,42 @@ +#!/usr/bin/perl + +use Modern::Perl; +use File::Temp qw/ tempdir /; +use Test::CGI::Multipart; +use Test::More tests => 11; + +use t::lib::Mocks; + +use C4::Context; +use C4::UploadedFiles; + +# This simulates a multipart POST request with a file upload. +my $tcm = new Test::CGI::Multipart; +$tcm->upload_file( + name => 'testfile', + file => 'testfilename.txt', + value => "This is the content of testfilename.txt", +); +my $cgi = $tcm->create_cgi; + +my $tempdir = tempdir(CLEANUP => 1); +t::lib::Mocks::mock_config('upload_path', $tempdir); + +my $testfilename = $cgi->param('testfile'); +my $testfile_fh = $cgi->upload('testfile'); +my $id = C4::UploadedFiles::UploadFile($testfilename, '', $testfile_fh->handle); +ok($id, "File uploaded, id is $id"); + +my $file = C4::UploadedFiles::GetUploadedFile($id); +isa_ok($file, 'HASH', "GetUploadedFiles($id)"); +foreach my $key (qw(id filename filepath dir)) { + ok(exists $file->{$key}, "GetUploadedFile($id)->{$key} exists"); +} + +ok(-e $file->{filepath}, "File $file->{filepath} exists"); + +ok(C4::UploadedFiles::DelUploadedFile($id), "DelUploadedFile($id) returned true"); +ok(! -e $file->{filepath}, "File $file->{filepath} does not exist anymore"); + +is(C4::UploadedFiles::UploadFile($testfilename, '../', $testfile_fh->handle), undef, 'UploadFile with $dir containing ".." return undef'); +is(C4::UploadedFiles::GetUploadedFile(), undef, 'GetUploadedFile without parameters returns undef'); --