View | Details | Raw Unified | Return to bug 19318
Collapse All | Expand All

(-)a/C4/ImportBatch.pm (-9 / +26 lines)
Lines 20-25 package C4::ImportBatch; Link Here
20
use strict;
20
use strict;
21
use warnings;
21
use warnings;
22
22
23
use Scalar::Util qw(openhandle);
24
23
use C4::Context;
25
use C4::Context;
24
use C4::Koha;
26
use C4::Koha;
25
use C4::Biblio;
27
use C4::Biblio;
Lines 1487-1493 sub SetImportRecordMatches { Link Here
1487
1489
1488
Reads ISO2709 binary porridge from the given file and creates MARC::Record-objects out of it.
1490
Reads ISO2709 binary porridge from the given file and creates MARC::Record-objects out of it.
1489
1491
1490
@PARAM1, String, absolute path to the ISO2709 file.
1492
@PARAM1, String, absolute path to the ISO2709 file or an open filehandle.
1491
@PARAM2, String, see stage_file.pl
1493
@PARAM2, String, see stage_file.pl
1492
@PARAM3, String, should be utf8
1494
@PARAM3, String, should be utf8
1493
1495
Lines 1502-1511 sub RecordsFromISO2709File { Link Here
1502
    my $marc_type = C4::Context->preference('marcflavour');
1504
    my $marc_type = C4::Context->preference('marcflavour');
1503
    $marc_type .= 'AUTH' if ($marc_type eq 'UNIMARC' && $record_type eq 'auth');
1505
    $marc_type .= 'AUTH' if ($marc_type eq 'UNIMARC' && $record_type eq 'auth');
1504
1506
1505
    open IN, "<$input_file" or die "$0: cannot open input file $input_file: $!\n";
1507
    my $fh;
1508
    if (openhandle($input_file)) {
1509
        $fh = $input_file;
1510
    } else {
1511
        open $fh, '<', $input_file or die "$0: cannot open input file $input_file: $!\n";
1512
    }
1513
1506
    my @marc_records;
1514
    my @marc_records;
1507
    $/ = "\035";
1515
    $/ = "\035";
1508
    while (<IN>) {
1516
    while (<$fh>) {
1509
        s/^\s+//;
1517
        s/^\s+//;
1510
        s/\s+$//;
1518
        s/\s+$//;
1511
        next unless $_; # skip if record has only whitespace, as might occur
1519
        next unless $_; # skip if record has only whitespace, as might occur
Lines 1517-1523 sub RecordsFromISO2709File { Link Here
1517
                "Unexpected charset $charset_guessed, expecting $encoding";
1525
                "Unexpected charset $charset_guessed, expecting $encoding";
1518
        }
1526
        }
1519
    }
1527
    }
1520
    close IN;
1528
    close $fh;
1529
1521
    return ( \@errors, \@marc_records );
1530
    return ( \@errors, \@marc_records );
1522
}
1531
}
1523
1532
Lines 1527-1533 sub RecordsFromISO2709File { Link Here
1527
1536
1528
Creates MARC::Record-objects out of the given MARCXML-file.
1537
Creates MARC::Record-objects out of the given MARCXML-file.
1529
1538
1530
@PARAM1, String, absolute path to the ISO2709 file.
1539
@PARAM1, String, absolute path to the ISO2709 file or an open filehandle
1531
@PARAM2, String, should be utf8
1540
@PARAM2, String, should be utf8
1532
1541
1533
Returns two array refs.
1542
Returns two array refs.
Lines 1550-1556 sub RecordsFromMARCXMLFile { Link Here
1550
1559
1551
=head2 RecordsFromMarcPlugin
1560
=head2 RecordsFromMarcPlugin
1552
1561
1553
    Converts text of input_file into array of MARC records with to_marc plugin
1562
Converts text of C<$input_file> into array of MARC records with to_marc plugin
1563
1564
C<$input_file> can be either a filename or an open filehandle.
1554
1565
1555
=cut
1566
=cut
1556
1567
Lines 1560-1574 sub RecordsFromMarcPlugin { Link Here
1560
    return \@return if !$input_file || !$plugin_class;
1571
    return \@return if !$input_file || !$plugin_class;
1561
1572
1562
    # Read input file
1573
    # Read input file
1563
    open IN, "<$input_file" or die "$0: cannot open input file $input_file: $!\n";
1574
    my $fh;
1575
    if (openhandle($input_file)) {
1576
        $fh = $input_file;
1577
    } else {
1578
        open $fh, '<', $input_file or die "$0: cannot open input file $input_file: $!\n";
1579
    }
1580
1564
    $/ = "\035";
1581
    $/ = "\035";
1565
    while (<IN>) {
1582
    while (<$fh>) {
1566
        s/^\s+//;
1583
        s/^\s+//;
1567
        s/\s+$//;
1584
        s/\s+$//;
1568
        next unless $_;
1585
        next unless $_;
1569
        $text .= $_;
1586
        $text .= $_;
1570
    }
1587
    }
1571
    close IN;
1588
    close $fh;
1572
1589
1573
    # Convert to large MARC blob with plugin
1590
    # Convert to large MARC blob with plugin
1574
    $text = Koha::Plugins::Handler->run({
1591
    $text = Koha::Plugins::Handler->run({
(-)a/C4/Installer/PerlDependencies.pm (-1 / +1 lines)
Lines 668-674 our $PERL_DEPS = { Link Here
668
        'min_ver'  => '0.60',
668
        'min_ver'  => '0.60',
669
    },
669
    },
670
    'Archive::Zip' => {
670
    'Archive::Zip' => {
671
        'usage'    => 'Plugins',
671
        'usage'    => 'Plugins, Local Cover Images',
672
        'required' => '0',
672
        'required' => '0',
673
        'min_ver'  => '1.30',
673
        'min_ver'  => '1.30',
674
    },
674
    },
(-)a/Koha/Storage.pm (+366 lines)
Line 0 Link Here
1
package Koha::Storage;
2
3
# Copyright 2018 BibLibre
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 3 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
=head1 NAME
21
22
Koha::Storage - Manage file storages
23
24
=head1 SYNOPSIS
25
26
    use Koha::Storage;
27
28
    # Get all available storages
29
    my $config = Koha::Storage->config;
30
31
    # Get storage instance by name
32
    # By default, 'TMP' and 'DEFAULT' are available
33
    # Others can be added in $KOHA_CONF
34
    my $storage = Koha::Storage->get_instance($name)
35
36
    my $directories = $storage->directories();
37
38
    my $filepath = $storage->filepath({
39
        hashvalue => $hashvalue,
40
        filename => $filename,
41
        dir => $dir,
42
    });
43
44
    my $exists = $storage->exists($filepath);
45
    my $deleted_count = $storage->delete($filepath);
46
47
    my $fh = $storage->fh($filepath, $mode);
48
49
    my $url = $storage->url($hashfile, $filepath);
50
51
=cut
52
53
use Modern::Perl;
54
55
use File::Spec;
56
use List::Util qw( first );
57
58
use C4::Context;
59
60
use constant KOHA_UPLOAD => 'koha_upload';
61
62
=head1 CLASS METHODS
63
64
=head2 config
65
66
Returns the configuration for all available storages.
67
68
    my $config = Koha::Storage->config
69
70
Returns an arrayref containing hashrefs. Example:
71
72
    [
73
        {
74
            name => 'TMP',
75
            adapter => 'directory',
76
            adapter_params => {
77
                path => '/tmp',
78
            },
79
            temporary => 1,
80
            hash_filename => 1,
81
        },
82
        {
83
            name => 'DEFAULT',
84
            ...
85
        },
86
        ...
87
    ]
88
89
Storages can be configured in C<$KOHA_CONF> by adding <storage> elements:
90
91
    <yazgfs>
92
        <config>
93
            <storage>
94
                <!-- Mandatory: Storage's identifier -->
95
                <name>MyStorage</name>
96
97
                <!-- Mandatory: 'directory' is the only available adapter actually -->
98
                <adapter>directory</adapter>
99
100
101
                <!-- Parameters specific to storage's adapter -->
102
                <adapter_params>
103
                    <!-- Mandatory for 'directory' adapter -->
104
                    <path>/mnt/mystorage</path>
105
                </adapter_params>
106
107
                <!-- Whether or not to prepend the hashvalue to filename -->
108
                <!-- Default: 0 -->
109
                <hash_filename>1</hash_filename>
110
111
                <!-- Whether or not the storage is temporary -->
112
                <!-- Default: 0 -->
113
                <temporary>0</temporary>
114
115
                <!-- If a baseurl is set, the file's URL is built by concatenating the baseurl and the filepath -->
116
                <!-- Otherwise it falls back to using opac-retrieve-file.pl -->
117
                <baseurl>https://mystorage.example.com/</baseurl>
118
            </storage>
119
            <!-- ... -->
120
        </config>
121
    </yazgfs>
122
123
The 'TMP' storage is always available and cannot be configured.
124
125
The 'DEFAULT' storage is available if:
126
127
=over
128
129
=item * C<upload_path> is set in C<$KOHA_CONF>, or
130
131
=item * a storage named 'DEFAULT' is configured in C<$KOHA_CONF>
132
133
=back
134
135
=cut
136
137
sub config {
138
    my $storage = C4::Context->config('storage');
139
140
    my $config;
141
    if (ref $storage eq 'ARRAY') {
142
        $config = [ @$storage ];
143
    } elsif ($storage) {
144
        $config = [ $storage ];
145
    } else {
146
        $config = [];
147
    }
148
149
    my $default = first { $_->{name} eq 'DEFAULT' } @$config;
150
    unless ($default) {
151
        # Backward compatibility for those who haven't changed their $KOHA_CONF
152
        warn "No 'DEFAULT' storage configured. Using upload_path as a fallback.";
153
154
        my $upload_path = C4::Context->config('upload_path');
155
        if ($upload_path) {
156
            unshift @$config, {
157
                name => 'DEFAULT',
158
                adapter => 'directory',
159
                adapter_params => {
160
                    path => C4::Context->config('upload_path'),
161
                },
162
                hash_filename => 1,
163
            };
164
        } else {
165
            warn "No upload_path defined."
166
        }
167
    }
168
169
    my $database = C4::Context->config('database');
170
    my $subdir = KOHA_UPLOAD =~ s/koha/$database/r;
171
    unshift @$config, {
172
        name => 'TMP',
173
        adapter => 'directory',
174
        adapter_params => {
175
            path => File::Spec->catfile(File::Spec->tmpdir, $subdir),
176
        },
177
        temporary => 1,
178
        hash_filename => 1,
179
    };
180
181
    return $config;
182
}
183
184
=head2 get_instance
185
186
Retrieves an instance of Koha::Storage
187
188
    my $storage = Koha::Storage->get_instance($name);
189
190
Returns a Koha::Storage object
191
192
=cut
193
194
my $instances = {};
195
196
sub get_instance {
197
    my ($class, $name) = @_;
198
199
    unless (exists $instances->{$name}) {
200
        my $storages = $class->config;
201
        my $storage = first { $_->{name} eq $name } @$storages;
202
203
        if ($storage) {
204
            $instances->{$name} = $class->new($storage);
205
        } else {
206
            warn "There is no storage named $name";
207
        }
208
    }
209
210
    return $instances->{$name};
211
}
212
213
=head2 new
214
215
Creates a new Koha::Storage object
216
217
    my $storage = Koha::Storage->new(\%params);
218
219
C<%params> can contain the same keys as the one returned by C<Koha::Storage-E<gt>config>
220
221
You shouldn't use this directly. Use C<Koha::Storage-E<gt>get_instance> instead
222
223
=cut
224
225
sub new {
226
    my ($class, $params) = @_;
227
228
    my $adapter_class = 'Koha::Storage::Adapter::' . ucfirst(lc($params->{adapter}));
229
    my $adapter;
230
    eval {
231
        my $adapter_file = $adapter_class =~ s,::,/,gr . '.pm';
232
        require $adapter_file;
233
        $adapter = $adapter_class->new($params->{adapter_params});
234
    };
235
    if ($@) {
236
        warn "Unable to create an instance of $adapter_class : $@";
237
238
        return;
239
    }
240
241
    my $self = $params;
242
    $self->{adapter} = $adapter;
243
244
    return bless $self, $class;
245
}
246
247
=head1 INSTANCE METHODS
248
249
=head2 filepath
250
251
Returns relative filepath of a file according to storage's parameters and file's
252
properties (filename, hashvalue, dir)
253
254
    my $filepath = $storage->filepath({
255
        hashvalue => $hashvalue,
256
        filename => $filename,
257
        dir => $dir,
258
    })
259
260
The return value is a required parameter for several other methods.
261
262
=cut
263
264
sub filepath {
265
    my ($self, $params) = @_;
266
267
    my $filepath;
268
    if ($params->{dir}) {
269
        $filepath .= $params->{dir} . '/';
270
    }
271
    if ($params->{hashvalue} && $self->{hash_filename}) {
272
        $filepath .= $params->{hashvalue} . '_';
273
    }
274
    $filepath .= $params->{filename};
275
276
    return $filepath;
277
}
278
279
=head2 exists
280
281
Check file existence
282
283
    my $filepath = $storage->filepath(\%params);
284
    my $exists = $storage->exists($filepath);
285
286
Returns a true value if the file exists, and a false value otherwise.
287
288
=cut
289
290
sub exists {
291
    my ($self, $filepath) = @_;
292
293
    return $self->{adapter}->exists($filepath);
294
}
295
296
=head2 fh
297
298
Returns a file handle for the given C<$filepath>
299
300
    my $filepath = $storage->filepath(\%params);
301
    my $fh = $storage->fh($filepath, $mode);
302
303
For possible values of C<$mode>, see L<perlfunc/open>
304
305
=cut
306
307
sub fh {
308
    my ($self, $filepath, $mode) = @_;
309
310
    return $self->{adapter}->fh($filepath, $mode);
311
}
312
313
=head2 directories
314
315
Returns a list of writable directories in storage
316
317
    my $directories = $storage->directories();
318
319
=cut
320
321
sub directories {
322
    my ($self) = @_;
323
324
    return $self->{adapter}->directories();
325
}
326
327
=head2 delete
328
329
Deletes a file
330
331
    my $filepath = $storage->filepath(\%params);
332
    $storage->delete($filepath);
333
334
=cut
335
336
sub delete {
337
    my ($self, $filepath) = @_;
338
339
    return $self->{adapter}->delete($filepath);
340
}
341
342
=head2 url
343
344
Returns the URL to access the file
345
346
    my $filepath = $storage->filepath(\%params);
347
    my $url = $storage->url($hashvalue, $filepath);
348
349
=cut
350
351
sub url {
352
    my ($self, $hashvalue, $filepath) = @_;
353
354
    if ($self->{baseurl}) {
355
        return $self->{baseurl} . $filepath;
356
    }
357
358
    # Default to opac-retrieve-file.pl
359
    my $url = C4::Context->preference('OPACBaseURL');
360
    $url =~ s/\/$//;
361
    $url .= '/cgi-bin/koha/opac-retrieve-file.pl?id=' . $hashvalue;
362
363
    return $url;
364
}
365
366
1;
(-)a/Koha/Storage/Adapter/Directory.pm (+174 lines)
Line 0 Link Here
1
package Koha::Storage::Adapter::Directory;
2
3
# Copyright 2018 BibLibre
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 3 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
=head1 NAME
21
22
Koha::Storage::Adapter::Directory - Storage adapter for a filesystem directory
23
24
=head1 DESCRIPTION
25
26
This is the default storage adapter. It stores files in a directory on the
27
filesystem.
28
29
You shouldn't use this directly. Use C<Koha::Storage> instead.
30
31
=cut
32
33
use Modern::Perl;
34
35
use File::Basename;
36
use File::Find;
37
use File::Path qw(make_path);
38
use File::Spec;
39
use IO::File;
40
41
=head1 INSTANCE METHODS
42
43
=head2 new
44
45
Creates a new C<Koha::Storage::Adapter::Directory> object.
46
47
    my $adapter = Koha::Storage::Adapter::Directory->new(\%params):
48
49
C<%params> contains the following keys:
50
51
=over
52
53
=item * C<path>: Mandatory. Absolute path of storage
54
55
=back
56
57
=cut
58
59
sub new {
60
    my ($class, $params) = @_;
61
62
    unless ($params->{path}) {
63
        die "Missing parameter 'path'";
64
    }
65
66
    my $self = { %$params };
67
68
    return bless $self, $class;
69
}
70
71
=head2 exists
72
73
See L<Koha::Storage/exists>.
74
75
=cut
76
77
sub exists {
78
    my ($self, $filepath) = @_;
79
80
    return -e $self->abspath($filepath);
81
}
82
83
=head2 fh
84
85
See L<Koha::Storage/fh>.
86
87
=cut
88
89
sub fh {
90
    my ($self, $filepath, $mode) = @_;
91
92
    my $abspath = $self->abspath($filepath);
93
94
    my $dirname = dirname($abspath);
95
    unless (-e $dirname) {
96
        eval {
97
            make_path($dirname);
98
        };
99
        if ($@) {
100
            warn "Unable to create path $dirname: $@";
101
            return;
102
        }
103
    }
104
105
    unless (-w $dirname) {
106
        warn "Directory $dirname is not writable";
107
        return;
108
    }
109
110
    my $fh = IO::File->new($abspath, $mode);
111
    unless ($fh) {
112
        warn "File creation failed for $abspath (mode $mode)";
113
        return;
114
    }
115
116
    $fh->binmode;
117
118
    return $fh;
119
}
120
121
=head2 directories
122
123
See L<Koha::Storage/directories>.
124
125
=cut
126
127
sub directories {
128
    my ($self) = @_;
129
130
    my @directories;
131
132
    if (-e $self->{path}) {
133
        find(sub {
134
            if (-d $File::Find::name) {
135
                my $relpath = $File::Find::name =~ s/^\Q$self->{path}\E\/?//r;
136
                push @directories, $relpath if $relpath;
137
            }
138
        }, $self->{path});
139
    }
140
141
    return \@directories;
142
}
143
144
=head2 delete
145
146
See L<Koha::Storage/delete>.
147
148
=cut
149
150
sub delete {
151
    my ($self, $filepath) = @_;
152
153
    return unlink $self->abspath($filepath);
154
}
155
156
=head1 INTERNAL METHODS
157
158
=head2 abspath
159
160
Returns the absolute path of a file
161
162
    my $abspath = $adapter->abspath($filepath);
163
164
=cut
165
166
sub abspath {
167
    my ($self, $filepath) = @_;
168
169
    my $abspath = File::Spec->catfile($self->{path}, $filepath);
170
171
    return $abspath;
172
}
173
174
1;
(-)a/Koha/UploadedFile.pm (-49 / +30 lines)
Lines 18-24 package Koha::UploadedFile; Link Here
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
19
20
use Modern::Perl;
20
use Modern::Perl;
21
use File::Spec;
21
22
use Koha::Storage;
22
23
23
use parent qw(Koha::Object);
24
use parent qw(Koha::Object);
24
25
Lines 36-44 Koha::UploadedFile - Koha::Object class for single uploaded file Link Here
36
    # get a file handle on an uploaded_file
37
    # get a file handle on an uploaded_file
37
    my $fh = $upload->file_handle;
38
    my $fh = $upload->file_handle;
38
39
39
    # get full path
40
    my $path = $upload->full_path;
41
42
    # delete uploaded file
40
    # delete uploaded file
43
    $upload->delete;
41
    $upload->delete;
44
42
Lines 46-53 Koha::UploadedFile - Koha::Object class for single uploaded file Link Here
46
44
47
Allows regular CRUD operations on uploaded_files via Koha::Object / DBIx.
45
Allows regular CRUD operations on uploaded_files via Koha::Object / DBIx.
48
46
49
The delete method also takes care of deleting files. The full_path method
47
The delete method also takes care of deleting files.
50
returns a fully qualified path for an upload.
51
48
52
Additional methods include: file_handle, httpheaders.
49
Additional methods include: file_handle, httpheaders.
53
50
Lines 72-78 sub delete { Link Here
72
    my ( $self, $params ) = @_;
69
    my ( $self, $params ) = @_;
73
70
74
    my $name = $self->filename;
71
    my $name = $self->filename;
75
    my $file = $self->full_path;
76
72
77
    my $retval = $self->SUPER::delete;
73
    my $retval = $self->SUPER::delete;
78
    if( !defined($retval) ) { # undef is Unknown (-1)
74
    if( !defined($retval) ) { # undef is Unknown (-1)
Lines 84-113 sub delete { Link Here
84
    }
80
    }
85
    return $retval if $params->{keep_file};
81
    return $retval if $params->{keep_file};
86
82
87
    if( ! -e $file ) {
83
    my $storage = Koha::Storage->get_instance($self->storage);
88
        warn "Removing record for $name within category ".
84
    my $filepath = $self->filepath;
89
            $self->uploadcategorycode. ", but file was missing.";
90
    } elsif( ! unlink($file) ) {
91
        warn "Problem while deleting: $file";
92
    }
93
    return $retval;
94
}
95
96
=head3 full_path
97
85
98
Returns the fully qualified path name for an uploaded file.
86
    if ( ! $storage->exists($filepath) ) {
99
87
        warn "Removing record for $name within storage " . $self->storage . ", but file was missing.";
100
=cut
88
    } elsif ( ! $storage->delete($filepath) ) {
89
        warn "Problem while deleting: $filepath";
90
    }
101
91
102
sub full_path {
92
    return $retval;
103
    my ( $self ) = @_;
104
    my $path = File::Spec->catfile(
105
        $self->permanent?
106
            $self->permanent_directory: $self->temporary_directory,
107
        $self->dir,
108
        $self->hashvalue. '_'. $self->filename,
109
    );
110
    return $path;
111
}
93
}
112
94
113
=head3 file_handle
95
=head3 file_handle
Lines 118-127 Returns a file handle for an uploaded file. Link Here
118
100
119
sub file_handle {
101
sub file_handle {
120
    my ( $self ) = @_;
102
    my ( $self ) = @_;
121
    $self->{_file_handle} = IO::File->new( $self->full_path, "r" );
103
122
    return if !$self->{_file_handle};
104
    my $storage = Koha::Storage->get_instance($self->storage);
123
    $self->{_file_handle}->binmode;
105
124
    return $self->{_file_handle};
106
    return $storage->fh($self->filepath, 'r');
125
}
107
}
126
108
127
=head3 httpheaders
109
=head3 httpheaders
Lines 140-169 sub httpheaders { Link Here
140
    );
122
    );
141
}
123
}
142
124
143
=head2 CLASS METHODS
125
sub url {
144
126
    my ($self) = @_;
145
=head3 permanent_directory
146
127
147
Returns root directory for permanent storage
128
    my $storage = Koha::Storage->get_instance($self->storage);
148
129
149
=cut
130
    return $storage->url($self->hashvalue, $self->filepath);
150
151
sub permanent_directory {
152
    my ( $class ) = @_;
153
    return C4::Context->config('upload_path');
154
}
131
}
155
132
156
=head3 tmp_directory
133
sub filepath {
157
134
    my ($self) = @_;
158
Returns root directory for temporary storage
159
135
160
=cut
136
    my $storage = Koha::Storage->get_instance($self->storage);
137
    my $filepath = $storage->filepath({
138
        hashvalue => $self->hashvalue,
139
        filename => $self->filename,
140
        dir => $self->dir,
141
    });
161
142
162
sub temporary_directory {
143
    return $filepath;
163
    my ( $class ) = @_;
164
    return File::Spec->tmpdir;
165
}
144
}
166
145
146
=head2 CLASS METHODS
147
167
=head3 _type
148
=head3 _type
168
149
169
Returns name of corresponding DBIC resultset
150
Returns name of corresponding DBIC resultset
(-)a/Koha/UploadedFiles.pm (-14 / +3 lines)
Lines 22-27 use Modern::Perl; Link Here
22
use C4::Koha;
22
use C4::Koha;
23
use Koha::Database;
23
use Koha::Database;
24
use Koha::DateUtils;
24
use Koha::DateUtils;
25
use Koha::Storage;
25
use Koha::UploadedFile;
26
use Koha::UploadedFile;
26
27
27
use parent qw(Koha::Objects);
28
use parent qw(Koha::Objects);
Lines 126-133 sub delete_missing { Link Here
126
    $self = Koha::UploadedFiles->new if !ref($self); # handle class call
127
    $self = Koha::UploadedFiles->new if !ref($self); # handle class call
127
    my $rv = 0;
128
    my $rv = 0;
128
    while( my $row = $self->next ) {
129
    while( my $row = $self->next ) {
129
        my $file = $row->full_path;
130
        my $storage = Koha::Storage->get_instance($row->storage);
130
        next if -e $file;
131
        next if $storage->exists($row->filepath);
131
        if( $params->{keep_record} ) {
132
        if( $params->{keep_record} ) {
132
            $rv++;
133
            $rv++;
133
            next;
134
            next;
Lines 166-183 sub search_term { Link Here
166
167
167
=head2 CLASS METHODS
168
=head2 CLASS METHODS
168
169
169
=head3 getCategories
170
171
getCategories returns a list of upload category codes and names
172
173
=cut
174
175
sub getCategories {
176
    my ( $class ) = @_;
177
    my $cats = C4::Koha::GetAuthorisedValues('UPLOAD');
178
    [ map {{ code => $_->{authorised_value}, name => $_->{lib} }} @$cats ];
179
}
180
181
=head3 _type
170
=head3 _type
182
171
183
Returns name of corresponding DBIC resultset
172
Returns name of corresponding DBIC resultset
(-)a/Koha/Uploader.pm (-68 / +55 lines)
Lines 31-37 Koha::Uploader - Facilitate file uploads (temporary and permanent) Link Here
31
31
32
    # add an upload (see tools/upload-file.pl)
32
    # add an upload (see tools/upload-file.pl)
33
    # the public flag allows retrieval via OPAC
33
    # the public flag allows retrieval via OPAC
34
    my $upload = Koha::Uploader->new( public => 1, category => 'A' );
34
    my $upload = Koha::Uploader->new( public => 1, storage => 'DEFAULT' );
35
    my $cgi = $upload->cgi;
35
    my $cgi = $upload->cgi;
36
    # Do something with $upload->count, $upload->result or $upload->err
36
    # Do something with $upload->count, $upload->result or $upload->err
37
37
Lines 58-72 Koha::Uploader - Facilitate file uploads (temporary and permanent) Link Here
58
58
59
=cut
59
=cut
60
60
61
use constant KOHA_UPLOAD => 'koha_upload';
62
use constant BYTES_DIGEST => 2048;
61
use constant BYTES_DIGEST => 2048;
63
62
64
use Modern::Perl;
63
use Modern::Perl;
65
use CGI; # no utf8 flag, since it may interfere with binary uploads
64
use CGI; # no utf8 flag, since it may interfere with binary uploads
66
use Digest::MD5;
65
use Digest::MD5;
67
use Encode;
66
use Encode;
68
use File::Spec;
69
use IO::File;
70
use Time::HiRes;
67
use Time::HiRes;
71
68
72
use base qw(Class::Accessor);
69
use base qw(Class::Accessor);
Lines 75-80 use C4::Context; Link Here
75
use C4::Koha;
72
use C4::Koha;
76
use Koha::UploadedFile;
73
use Koha::UploadedFile;
77
use Koha::UploadedFiles;
74
use Koha::UploadedFiles;
75
use Koha::Storage;
78
76
79
__PACKAGE__->mk_ro_accessors( qw|| );
77
__PACKAGE__->mk_ro_accessors( qw|| );
80
78
Lines 82-91 __PACKAGE__->mk_ro_accessors( qw|| ); Link Here
82
80
83
=head2 new
81
=head2 new
84
82
85
    Returns new object based on Class::Accessor.
83
Returns new object based on Class::Accessor.
86
    Use tmp or temp flag for temporary storage.
84
87
    Use public flag to mark uploads as available in OPAC.
85
    my $uploader = Koha::Uploader->new(\%params);
88
    The category parameter is only useful for permanent storage.
86
87
C<%params> contains the following keys:
88
89
=over
90
91
=item * C<storage>: Mandatory. Storage's name
92
93
=item * C<dir>: Subdirectory in storage
94
95
=item * C<public>: Whether or not the uploaded files are public (available in OPAC).
96
97
=back
89
98
90
=cut
99
=cut
91
100
Lines 188-261 sub allows_add_by { Link Here
188
sub _init {
197
sub _init {
189
    my ( $self, $params ) = @_;
198
    my ( $self, $params ) = @_;
190
199
191
    $self->{rootdir} = Koha::UploadedFile->permanent_directory;
200
    $self->{storage} = Koha::Storage->get_instance($params->{storage});
192
    $self->{tmpdir} = Koha::UploadedFile->temporary_directory;
193
194
    $params->{tmp} = $params->{temp} if !exists $params->{tmp};
195
    $self->{temporary} = $params->{tmp}? 1: 0; #default false
196
    if( $params->{tmp} ) {
197
        my $db =  C4::Context->config('database');
198
        $self->{category} = KOHA_UPLOAD;
199
        $self->{category} =~ s/koha/$db/;
200
    } else {
201
        $self->{category} = $params->{category} || KOHA_UPLOAD;
202
    }
203
204
    $self->{files} = {};
201
    $self->{files} = {};
205
    $self->{uid} = C4::Context->userenv->{number} if C4::Context->userenv;
202
    $self->{uid} = C4::Context->userenv->{number} if C4::Context->userenv;
206
    $self->{public} = $params->{public}? 1: undef;
203
    $self->{public} = $params->{public} ? 1 : 0;
204
    $self->{dir} = $params->{dir} // '';
207
}
205
}
208
206
209
sub _fh {
207
sub _fh {
210
    my ( $self, $filename ) = @_;
208
    my ( $self, $filename ) = @_;
211
    if( $self->{files}->{$filename} ) {
209
210
    if ( $self->{files}->{$filename} ) {
212
        return $self->{files}->{$filename}->{fh};
211
        return $self->{files}->{$filename}->{fh};
213
    }
212
    }
214
}
213
}
215
214
216
sub _create_file {
215
sub _create_file {
217
    my ( $self, $filename ) = @_;
216
    my ( $self, $filename ) = @_;
218
    my $fh;
217
219
    if( $self->{files}->{$filename} &&
218
    return if ($self->{files}->{$filename} && $self->{files}->{$filename}->{errcode});
220
            $self->{files}->{$filename}->{errcode} ) {
219
    my $hashval = $self->{files}->{$filename}->{hash};
221
        #skip
220
    my $filepath = $self->{storage}->filepath({
222
    } elsif( !$self->{temporary} && !$self->{rootdir} ) {
221
        hashvalue => $hashval,
223
        $self->{files}->{$filename}->{errcode} = 3; #no rootdir
222
        filename => $filename,
224
    } elsif( $self->{temporary} && !$self->{tmpdir} ) {
223
        dir => $self->{dir},
225
        $self->{files}->{$filename}->{errcode} = 4; #no tempdir
224
    });
225
226
    # if the file exists and it is registered, then set error
227
    # if it exists, but is not in the database, we will overwrite
228
    if ( $self->{storage}->exists($filepath) &&
229
    Koha::UploadedFiles->search({
230
        hashvalue => $hashval,
231
        storage => $self->{storage}->{name},
232
    })->count ) {
233
        $self->{files}->{$filename}->{errcode} = 1; #already exists
234
        return;
235
    }
236
237
    my $fh = $self->{storage}->fh($filepath, 'w');
238
    if ($fh) {
239
        $self->{files}->{$filename}->{fh} = $fh;
226
    } else {
240
    } else {
227
        my $dir = $self->_dir;
241
        $self->{files}->{$filename}->{errcode} = 2; #not writable
228
        my $hashval = $self->{files}->{$filename}->{hash};
229
        my $fn = $hashval. '_'. $filename;
230
231
        # if the file exists and it is registered, then set error
232
        # if it exists, but is not in the database, we will overwrite
233
        if( -e "$dir/$fn" &&
234
        Koha::UploadedFiles->search({
235
            hashvalue          => $hashval,
236
            uploadcategorycode => $self->{category},
237
        })->count ) {
238
            $self->{files}->{$filename}->{errcode} = 1; #already exists
239
            return;
240
        }
241
242
        $fh = IO::File->new( "$dir/$fn", "w");
243
        if( $fh ) {
244
            $fh->binmode;
245
            $self->{files}->{$filename}->{fh}= $fh;
246
        } else {
247
            $self->{files}->{$filename}->{errcode} = 2; #not writable
248
        }
249
    }
242
    }
250
    return $fh;
251
}
252
243
253
sub _dir {
244
    return $fh;
254
    my ( $self ) = @_;
255
    my $dir = $self->{temporary}? $self->{tmpdir}: $self->{rootdir};
256
    $dir.= '/'. $self->{category};
257
    mkdir $dir if !-d $dir;
258
    return $dir;
259
}
245
}
260
246
261
sub _hook {
247
sub _hook {
Lines 280-293 sub _done { Link Here
280
sub _register {
266
sub _register {
281
    my ( $self, $filename, $size ) = @_;
267
    my ( $self, $filename, $size ) = @_;
282
    my $rec = Koha::UploadedFile->new({
268
    my $rec = Koha::UploadedFile->new({
269
        storage   => $self->{storage}->{name},
283
        hashvalue => $self->{files}->{$filename}->{hash},
270
        hashvalue => $self->{files}->{$filename}->{hash},
284
        filename  => $filename,
271
        filename  => $filename,
285
        dir       => $self->{category},
272
        dir       => $self->{dir},
286
        filesize  => $size,
273
        filesize  => $size,
287
        owner     => $self->{uid},
274
        owner     => $self->{uid},
288
        uploadcategorycode => $self->{category},
289
        public    => $self->{public},
275
        public    => $self->{public},
290
        permanent => $self->{temporary}? 0: 1,
276
        permanent => $self->{storage}->{temporary} ? 0 : 1,
291
    })->store;
277
    })->store;
292
    $self->{files}->{$filename}->{id} = $rec->id if $rec;
278
    $self->{files}->{$filename}->{id} = $rec->id if $rec;
293
}
279
}
Lines 297-307 sub _compute { Link Here
297
# For temporary files, the id is made unique with time
283
# For temporary files, the id is made unique with time
298
    my ( $self, $name, $block ) = @_;
284
    my ( $self, $name, $block ) = @_;
299
    if( !$self->{files}->{$name}->{hash} ) {
285
    if( !$self->{files}->{$name}->{hash} ) {
300
        my $str = $name. ( $self->{uid} // '0' ).
286
        my $str = $name . ( $self->{uid} // '0' ) .
301
            ( $self->{temporary}? Time::HiRes::time(): '' ).
287
            ( $self->{storage}->{temporary} ? Time::HiRes::time() : '' ) .
302
            $self->{category}. substr( $block, 0, BYTES_DIGEST );
288
            $self->{storage}->{name} . $self->{dir} .
289
            substr( $block, 0, BYTES_DIGEST );
303
        # since Digest cannot handle wide chars, we need to encode here
290
        # since Digest cannot handle wide chars, we need to encode here
304
        # there could be a wide char in the filename or the category
291
        # there could be a wide char in the filename
305
        my $h = Digest::MD5::md5_hex( Encode::encode_utf8( $str ) );
292
        my $h = Digest::MD5::md5_hex( Encode::encode_utf8( $str ) );
306
        $self->{files}->{$name}->{hash} = $h;
293
        $self->{files}->{$name}->{hash} = $h;
307
    }
294
    }
(-)a/cataloguing/value_builder/upload.pl (+3 lines)
Lines 41-46 my $builder = sub { Link Here
41
            if( str && str.match(/id=([0-9a-f]+)/) ) {
41
            if( str && str.match(/id=([0-9a-f]+)/) ) {
42
                term = RegExp.\$1;
42
                term = RegExp.\$1;
43
                myurl = '../tools/upload.pl?op=search&index='+index+'&term='+term+'&plugin=1';
43
                myurl = '../tools/upload.pl?op=search&index='+index+'&term='+term+'&plugin=1';
44
            } else if (str && str.match(/\\/([^\\/]*)\$/)) {
45
                term = RegExp.\$1;
46
                myurl = '../tools/upload.pl?op=search&index='+index+'&term='+term+'&plugin=1';
44
            } else {
47
            } else {
45
                myurl = '../tools/upload.pl?op=new&index='+index+'&plugin=1';
48
                myurl = '../tools/upload.pl?op=new&index='+index+'&plugin=1';
46
            }
49
            }
(-)a/etc/koha-conf.xml (-1 / +9 lines)
Lines 92-98 __PAZPAR2_TOGGLE_XML_POST__ Link Here
92
 <authorityservershadow>1</authorityservershadow>
92
 <authorityservershadow>1</authorityservershadow>
93
 <pluginsdir>__PLUGINS_DIR__</pluginsdir>
93
 <pluginsdir>__PLUGINS_DIR__</pluginsdir>
94
 <enable_plugins>0</enable_plugins>
94
 <enable_plugins>0</enable_plugins>
95
 <upload_path></upload_path>
95
 <storage>
96
    <name>DEFAULT</name>
97
    <adapter>directory</adapter>
98
    <adapter_params>
99
        <!-- Set storage path to enable the default permanent storage -->
100
        <path></path>
101
    </adapter_params>
102
    <hash_filename>1</hash_filename>
103
 </storage>
96
 <intranetdir>__INTRANET_CGI_DIR__</intranetdir>
104
 <intranetdir>__INTRANET_CGI_DIR__</intranetdir>
97
 <opacdir>__OPAC_CGI_DIR__/opac</opacdir>
105
 <opacdir>__OPAC_CGI_DIR__/opac</opacdir>
98
 <opachtdocs>__OPAC_TMPL_DIR__</opachtdocs>
106
 <opachtdocs>__OPAC_TMPL_DIR__</opachtdocs>
(-)a/installer/data/mysql/atomicupdate/bug_19318.perl (+36 lines)
Line 0 Link Here
1
$DBversion = 'XXX';
2
if( CheckVersion( $DBversion ) ) {
3
    unless (column_exists('uploaded_files', 'storage')) {
4
        $dbh->do(q{
5
            ALTER TABLE uploaded_files
6
            ADD COLUMN storage VARCHAR(255) NULL DEFAULT NULL AFTER id
7
        });
8
    }
9
10
    if (column_exists('uploaded_files', 'uploadcategorycode')) {
11
        $dbh->do(q{
12
            ALTER TABLE uploaded_files
13
            DROP COLUMN uploadcategorycode
14
        });
15
    }
16
17
    $dbh->do(q{
18
        UPDATE uploaded_files
19
        SET storage = IF(permanent, 'DEFAULT', 'TMP')
20
        WHERE storage IS NULL OR storage = ''
21
    });
22
23
    $dbh->do(q{
24
        UPDATE uploaded_files
25
        SET dir = ''
26
        WHERE storage = 'TMP'
27
    });
28
29
    $dbh->do(q{
30
        ALTER TABLE uploaded_files
31
        MODIFY COLUMN storage VARCHAR(255) NOT NULL
32
    });
33
34
    SetVersion( $DBversion );
35
    print "Upgrade to $DBversion done (Bug 19318 - Allow multiple storage spaces for file uploads)\n";
36
}
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/offline_circ/process_koc.tt (-1 / +1 lines)
Lines 94-100 Link Here
94
            $("#fileuploadstatus").show();
94
            $("#fileuploadstatus").show();
95
            $("form#processfile #uploadedfileid").val('');
95
            $("form#processfile #uploadedfileid").val('');
96
            $("form#enqueuefile #uploadedfileid").val('');
96
            $("form#enqueuefile #uploadedfileid").val('');
97
            xhr= AjaxUpload( $('#fileToUpload'), $('#fileuploadprogress'), 'temp=1', cbUpload );
97
            xhr= AjaxUpload( $('#fileToUpload'), $('#fileuploadprogress'), 'storage=TMP', cbUpload );
98
        }
98
        }
99
99
100
        function cbUpload( status, fileid, errors ) {
100
        function cbUpload( status, fileid, errors ) {
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/stage-marc-import.tt (-1 / +1 lines)
Lines 238-244 Link Here
238
            $("#processfile").hide();
238
            $("#processfile").hide();
239
            $("#fileuploadstatus").show();
239
            $("#fileuploadstatus").show();
240
            $("#uploadedfileid").val('');
240
            $("#uploadedfileid").val('');
241
            xhr= AjaxUpload( $('#fileToUpload'), $('#fileuploadprogress'), 'temp=1', cbUpload );
241
            xhr= AjaxUpload( $('#fileToUpload'), $('#fileuploadprogress'), 'storage=TMP', cbUpload );
242
            $("#fileuploadcancel").show();
242
            $("#fileuploadcancel").show();
243
        }
243
        }
244
        function CancelUpload() {
244
        function CancelUpload() {
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/upload-images.tt (-1 / +1 lines)
Lines 118-124 Link Here
118
            $('#uploadform button.submit').prop('disabled',true);
118
            $('#uploadform button.submit').prop('disabled',true);
119
            $("#fileuploadstatus").show();
119
            $("#fileuploadstatus").show();
120
            $("#uploadedfileid").val('');
120
            $("#uploadedfileid").val('');
121
            xhr= AjaxUpload( $('#fileToUpload'), $('#fileuploadprogress'), 'temp=1', cbUpload );
121
            xhr= AjaxUpload( $('#fileToUpload'), $('#fileuploadprogress'), 'storage=TMP', cbUpload );
122
        }
122
        }
123
        function cbUpload( status, fileid, errors ) {
123
        function cbUpload( status, fileid, errors ) {
124
            if( status=='done' ) {
124
            if( status=='done' ) {
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/upload.tt (-42 / +67 lines)
Lines 1-4 Link Here
1
[% USE Koha %]
1
[% USE Koha %]
2
[% USE JSON.Escape %]
2
[% SET footerjs = 1 %]
3
[% SET footerjs = 1 %]
3
[% INCLUDE 'doc-head-open.inc' %]
4
[% INCLUDE 'doc-head-open.inc' %]
4
[% IF plugin %]
5
[% IF plugin %]
Lines 9-14 Link Here
9
[% INCLUDE 'doc-head-close.inc' %]
10
[% INCLUDE 'doc-head-close.inc' %]
10
<link rel="stylesheet" type="text/css" href="[% interface %]/[% theme %]/css/datatables.css" />
11
<link rel="stylesheet" type="text/css" href="[% interface %]/[% theme %]/css/datatables.css" />
11
12
13
[% BLOCK storage_label %]
14
    [% SWITCH name %]
15
        [% CASE 'TMP' %]Temporary
16
        [% CASE 'DEFAULT' %]Default
17
        [% CASE %][% name %]
18
    [% END %]
19
[% END %]
20
12
[% BLOCK plugin_pars %]
21
[% BLOCK plugin_pars %]
13
    [% IF plugin %]
22
    [% IF plugin %]
14
        <input type="hidden" name="plugin" value="1" />
23
        <input type="hidden" name="plugin" value="1" />
Lines 46-73 Link Here
46
            <input type="file" id="fileToUpload" name="fileToUpload" multiple/>
55
            <input type="file" id="fileToUpload" name="fileToUpload" multiple/>
47
        </div>
56
        </div>
48
        </li>
57
        </li>
49
        [% IF uploadcategories %]
58
        <li>
50
            <li>
59
            <label for="storage">Storage: </label>
51
                <label for="uploadcategory">Category: </label>
60
            <select id="storage" name="storage">
52
                <select id="uploadcategory" name="uploadcategory">
61
                [% FOREACH storage IN storages %]
53
                [% IF !plugin %]
62
                    [% UNLESS plugin && storage.temporary %]
54
                    <option value=""></option>
63
                        <option value="[% storage.name %]">[% PROCESS storage_label name=storage.name %]</option>
55
                [% END %]
64
                    [% END %]
56
                [% FOREACH cat IN uploadcategories %]
57
                    <option value="[% cat.code %]">[% cat.name %]</option>
58
                [% END %]
65
                [% END %]
59
                </select>
66
            </select>
60
            </li>
67
        </li>
61
        [% END %]
68
        <li>
62
        [% IF !plugin %]
69
            <label for="dir">Directory: </label>
63
            <li>
70
            <select id="dir" name="dir">
64
            [% IF uploadcategories %]
71
            </select>
65
                <div class="hint">Note: For temporary uploads do not select a category.</div>
72
        </li>
66
            [% ELSE %]
67
                <div class="hint">Note: No upload categories are defined. Add values to the UPLOAD authorized value category otherwise all uploads will be marked as temporary.</div>
68
            [% END %]
69
            </li>
70
        [% END %]
71
        <li>
73
        <li>
72
            [% IF plugin %]
74
            [% IF plugin %]
73
                <input type="hidden" id="public" name="public" value="1"/>
75
                <input type="hidden" id="public" name="public" value="1"/>
Lines 155-163 Link Here
155
        <th>Filename</th>
157
        <th>Filename</th>
156
        <th>Size</th>
158
        <th>Size</th>
157
        <th>Hashvalue</th>
159
        <th>Hashvalue</th>
158
        <th>Category</th>
160
        <th>Storage</th>
159
        [% IF !plugin %]<th>Public</th>[% END %]
161
        <th>Directory</th>
160
        [% IF !plugin %]<th>Temporary</th>[% END %]
162
        [% IF !plugin %]
163
            <th>Public</th>
164
            <th>Temporary</th>
165
        [% END %]
161
        <th class="nosort">Actions</th>
166
        <th class="nosort">Actions</th>
162
    </tr>
167
    </tr>
163
    </thead>
168
    </thead>
Lines 167-180 Link Here
167
        <td>[% record.filename %]</td>
172
        <td>[% record.filename %]</td>
168
        <td>[% record.filesize %]</td>
173
        <td>[% record.filesize %]</td>
169
        <td>[% record.hashvalue %]</td>
174
        <td>[% record.hashvalue %]</td>
170
        <td>[% record.uploadcategorycode %]</td>
175
        <td>[% PROCESS storage_label name=record.storage %]</td>
176
        <td>[% record.dir %]</td>
171
        [% IF !plugin %]
177
        [% IF !plugin %]
172
            <td>[% IF record.public %]Yes[% ELSE %]No[% END %]</td>
178
            <td>[% IF record.public %]Yes[% ELSE %]No[% END %]</td>
173
            <td>[% IF record.permanent %]No[% ELSE %]Yes[% END %]</td>
179
            <td>[% IF record.permanent %]No[% ELSE %]Yes[% END %]</td>
174
        [% END %]
180
        [% END %]
175
        <td class="actions">
181
        <td class="actions">
176
            [% IF plugin %]
182
            [% IF plugin %]
177
                <button class="btn btn-default btn-xs choose_entry" data-record-hashvalue="[% record.hashvalue %]"><i class="fa fa-plus"></i> Choose</button>
183
                <button class="btn btn-default btn-xs choose_entry" data-record-url="[% record.url | html %]"><i class="fa fa-plus"></i> Choose</button>
178
            [% END %]
184
            [% END %]
179
            <button class="btn btn-default btn-xs download_entry" data-record-id="[% record.id %]"><i class="fa fa-download"></i> Download</button>
185
            <button class="btn btn-default btn-xs download_entry" data-record-id="[% record.id %]"><i class="fa fa-download"></i> Download</button>
180
            [% IF record.owner == owner || CAN_user_tools_upload_manage %]
186
            [% IF record.owner == owner || CAN_user_tools_upload_manage %]
Lines 251-257 Link Here
251
    <script type="text/javascript">
257
    <script type="text/javascript">
252
        var errMESSAGES = [
258
        var errMESSAGES = [
253
            "Error 0: Not in use",
259
            "Error 0: Not in use",
254
            _("This file already exists (in this category)."),
260
            _("This file already exists (in this storage)."),
255
            _("File could not be created. Check permissions."),
261
            _("File could not be created. Check permissions."),
256
            _("Your koha-conf.xml does not contain a valid upload_path."),
262
            _("Your koha-conf.xml does not contain a valid upload_path."),
257
            _("No temporary directory found."),
263
            _("No temporary directory found."),
Lines 275-291 Link Here
275
            $("#searchfile").hide();
281
            $("#searchfile").hide();
276
            $("#lastbreadcrumb").text( _("Add a new upload") );
282
            $("#lastbreadcrumb").text( _("Add a new upload") );
277
283
278
            var cat, xtra='';
284
            var xtra = 'storage=' + $('#storage').val();
279
            if( $("#uploadcategory").val() )
285
            xtra = xtra + '&dir=' + $('#dir').val();
280
                cat = encodeURIComponent( $("#uploadcategory").val() );
281
            if( cat ) xtra= 'category=' + cat + '&';
282
            [% IF plugin %]
286
            [% IF plugin %]
283
                xtra = xtra + 'public=1&temp=0';
287
                xtra = xtra + '&public=1';
284
            [% ELSE %]
288
            [% ELSE %]
285
                if( !cat ) xtra = 'temp=1&';
289
                if ( $('#public').prop('checked') ) {
286
                if( $('#public').prop('checked') ) xtra = xtra + 'public=1';
290
                    xtra = xtra + '&public=1';
291
                }
287
            [% END %]
292
            [% END %]
288
            xhr= AjaxUpload( $('#fileToUpload'), $('#fileuploadprogress'), xtra, cbUpload );
293
            xhr = AjaxUpload( $('#fileToUpload'), $('#fileuploadprogress'), xtra, cbUpload );
289
        }
294
        }
290
        function CancelUpload() {
295
        function CancelUpload() {
291
            if( xhr ) xhr.abort();
296
            if( xhr ) xhr.abort();
Lines 348-359 Link Here
348
                $(window.opener.document).find('#[% index %]').val( '' );
353
                $(window.opener.document).find('#[% index %]').val( '' );
349
            [% END %]
354
            [% END %]
350
        }
355
        }
351
        function Choose(hashval) {
356
        function Choose(url) {
352
            var res = '[% Koha.Preference('OPACBaseURL') %]';
353
            res = res.replace( /\/$/, '');
354
            res = res + '/cgi-bin/koha/opac-retrieve-file.pl?id=' + hashval;
355
            [% IF index %]
357
            [% IF index %]
356
                $(window.opener.document).find('#[% index %]').val( res );
358
                $(window.opener.document).find('#[% index %]').val( url );
357
            [% END %]
359
            [% END %]
358
            window.close();
360
            window.close();
359
        }
361
        }
Lines 384-391 Link Here
384
            });
386
            });
385
            $(".choose_entry").on("click",function(e){
387
            $(".choose_entry").on("click",function(e){
386
                e.preventDefault();
388
                e.preventDefault();
387
                var record_hashvalue = $(this).data("record-hashvalue");
389
                var record_url = $(this).data("record-url");
388
                Choose( record_hashvalue );
390
                Choose( record_url );
389
            });
391
            });
390
            $(".download_entry").on("click",function(e){
392
            $(".download_entry").on("click",function(e){
391
                e.preventDefault();
393
                e.preventDefault();
Lines 403-408 Link Here
403
            });
405
            });
404
        });
406
        });
405
    </script>
407
    </script>
408
    <script>
409
        [% FOREACH storage IN storages %]
410
            [% name = storage.name %]
411
            [% storage_directories.$name = storage.directories %]
412
        [% END %]
413
414
        $(document).ready(function () {
415
            let storage_directories = [% storage_directories.json %];
416
            $('#storage').on('change', function () {
417
                $('#dir').empty();
418
                $('#dir').append($('<option>').val('').html(_("(root)")));
419
                let name = $(this).val()
420
                if (name in storage_directories) {
421
                    storage_directories[name].forEach(function (dir) {
422
                        let option = $('<option>')
423
                            .val(dir)
424
                            .html(dir);
425
                        $('#dir').append(option);
426
                    })
427
                }
428
            }).change();
429
        });
430
    </script>
406
[% END %]
431
[% END %]
407
432
408
[% INCLUDE 'intranet-bottom.inc' %]
433
[% INCLUDE 'intranet-bottom.inc' %]
(-)a/t/ImportBatch.t (-2 / +13 lines)
Lines 31-37 BEGIN { Link Here
31
t::lib::Mocks::mock_preference('marcflavour', 'MARC21');
31
t::lib::Mocks::mock_preference('marcflavour', 'MARC21');
32
32
33
subtest 'RecordsFromISO2709File' => sub {
33
subtest 'RecordsFromISO2709File' => sub {
34
    plan tests => 4;
34
    plan tests => 5;
35
35
36
    my ( $errors, $recs );
36
    my ( $errors, $recs );
37
    my $file = create_file({ whitespace => 1, format => 'marc' });
37
    my $file = create_file({ whitespace => 1, format => 'marc' });
Lines 48-57 subtest 'RecordsFromISO2709File' => sub { Link Here
48
    ( $errors, $recs ) = C4::ImportBatch::RecordsFromISO2709File( $file, 'biblio', 'UTF-8' );
48
    ( $errors, $recs ) = C4::ImportBatch::RecordsFromISO2709File( $file, 'biblio', 'UTF-8' );
49
    is( @$recs, 2, 'File contains 2 records' );
49
    is( @$recs, 2, 'File contains 2 records' );
50
50
51
    $file = create_file({ two => 1, format => 'marc' });
52
    open my $fh, '<', $file;
53
    ( $errors, $recs ) = C4::ImportBatch::RecordsFromISO2709File( $fh, 'biblio', 'UTF-8' );
54
    close $fh;
55
    is( @$recs, 2, 'Can take a file handle as parameter' );
56
51
};
57
};
52
58
53
subtest 'RecordsFromMARCXMLFile' => sub {
59
subtest 'RecordsFromMARCXMLFile' => sub {
54
    plan tests => 3;
60
    plan tests => 4;
55
61
56
    my ( $errors, $recs );
62
    my ( $errors, $recs );
57
    my $file = create_file({ whitespace => 1, format => 'marcxml' });
63
    my $file = create_file({ whitespace => 1, format => 'marcxml' });
Lines 66-71 subtest 'RecordsFromMARCXMLFile' => sub { Link Here
66
    ( $errors, $recs ) = C4::ImportBatch::RecordsFromMARCXMLFile( $file, 'UTF-8' );
72
    ( $errors, $recs ) = C4::ImportBatch::RecordsFromMARCXMLFile( $file, 'UTF-8' );
67
    is( @$recs, 2, 'File has two records' );
73
    is( @$recs, 2, 'File has two records' );
68
74
75
    $file = create_file({ two => 1, format => 'marcxml' });
76
    open my $fh, '<', $file;
77
    ( $errors, $recs ) = C4::ImportBatch::RecordsFromMARCXMLFile( $fh, 'UTF-8' );
78
    close $fh;
79
    is( @$recs, 2, 'Can take a filehandle as parameter' );
69
};
80
};
70
81
71
sub create_file {
82
sub create_file {
(-)a/t/Koha/Storage.t (+183 lines)
Line 0 Link Here
1
# Copyright 2018 BibLibre
2
#
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it under the
6
# terms of the GNU General Public License as published by the Free Software
7
# Foundation; either version 3 of the License, or (at your option) any later
8
# version.
9
#
10
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
11
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13
#
14
# You should have received a copy of the GNU General Public License along
15
# with Koha; if not, write to the Free Software Foundation, Inc.,
16
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
17
18
use Modern::Perl;
19
20
use File::Path qw(remove_tree make_path);
21
use File::Spec;
22
use File::Temp qw(tempdir);
23
use Test::More tests => 5;
24
use Test::MockModule;
25
26
use C4::Context;
27
28
BEGIN { use_ok('Koha::Storage') }
29
30
my $storage_config = [
31
    {
32
        name => 'DEFAULT',
33
        adapter => 'directory',
34
        adapter_params => {
35
            path => tempdir('koha-storage-DEFAULT-XXXXXX', TMPDIR => 1, CLEANUP => 1),
36
        },
37
        hash_filename => 1,
38
    },
39
    {
40
        name => 'external',
41
        adapter => 'directory',
42
        adapter_params => {
43
            path => tempdir('koha-storage-external-XXXXXX', TMPDIR => 1, CLEANUP => 1),
44
        },
45
        baseurl => 'https://external.example.com/',
46
    },
47
];
48
49
my $c4_context = Test::MockModule->new('C4::Context');
50
$c4_context->mock('config', sub {
51
    my ($class, $name) = @_;
52
53
    if ($name eq 'storage') {
54
        return $storage_config;
55
    }
56
57
    return C4::Context::_common_config($name, 'config')
58
});
59
60
my $config = Koha::Storage->config;
61
62
my $expected = [
63
    {
64
        name => 'TMP',
65
        adapter => 'directory',
66
        adapter_params => {
67
            path => File::Spec->catfile(File::Spec->tmpdir, C4::Context->config('database') . '_upload'),
68
        },
69
        temporary => 1,
70
        hash_filename => 1,
71
    },
72
    @$storage_config,
73
];
74
75
is_deeply($config, $expected, 'Koha::Storage->config return value is as expected');
76
77
subtest 'TMP' => sub {
78
    plan tests => 8;
79
80
    # Clean temporary storage
81
    my $tmpdir = $config->[0]->{adapter_params}->{path};
82
    if (-e $tmpdir) {
83
        remove_tree($tmpdir);
84
    }
85
86
    my $tmp_storage = Koha::Storage->get_instance('TMP');
87
    isa_ok($tmp_storage, 'Koha::Storage', 'Koha::Storage->get_instance return value');
88
    is($tmp_storage->{name}, 'TMP', 'Koha::Storage->get_instance returns the correct instance');
89
90
    my $filepath = $tmp_storage->filepath({
91
        dir => 'one/two',
92
        hashvalue => 'abcdef',
93
        filename => 'foo.bar',
94
    });
95
    is($filepath, 'one/two/abcdef_foo.bar', 'filepath is correct');
96
97
    ok(!$tmp_storage->exists($filepath), "$filepath doesn't exist yet");
98
99
    my $fh = $tmp_storage->fh($filepath, 'w');
100
    print $fh 'foo.bar content';
101
    close $fh;
102
103
    ok($tmp_storage->exists($filepath), "$filepath now exists");
104
105
    $fh = $tmp_storage->fh($filepath, 'r');
106
    my $content = <$fh>;
107
    is($content, 'foo.bar content', "$filepath content is as expected");
108
109
    my $directories = $tmp_storage->directories;
110
    is_deeply($directories, ['one', 'one/two'], 'directories() return value is as expected');
111
112
    my $url = $tmp_storage->url('abcdef', $filepath);
113
    my $expected_url = C4::Context->preference('OPACBaseURL') . '/cgi-bin/koha/opac-retrieve-file.pl?id=abcdef';
114
    is($url, $expected_url, 'url() return value is as expected');
115
};
116
117
subtest 'DEFAULT' => sub {
118
    plan tests => 8;
119
120
    my $storage = Koha::Storage->get_instance('DEFAULT');
121
    isa_ok($storage, 'Koha::Storage', 'Koha::Storage->get_instance return value');
122
    is($storage->{name}, 'DEFAULT', 'Koha::Storage->get_instance returns the correct instance');
123
124
    my $filepath = $storage->filepath({
125
        dir => 'one/two',
126
        hashvalue => 'abcdef',
127
        filename => 'foo.bar',
128
    });
129
    is($filepath, 'one/two/abcdef_foo.bar', 'filepath is correct');
130
131
    ok(!$storage->exists($filepath), "$filepath doesn't exist yet");
132
133
    my $fh = $storage->fh($filepath, 'w');
134
    print $fh 'foo.bar content';
135
    close $fh;
136
137
    ok($storage->exists($filepath), "$filepath now exists");
138
139
    $fh = $storage->fh($filepath, 'r');
140
    my $content = <$fh>;
141
    is($content, 'foo.bar content', "$filepath content is as expected");
142
143
    my $directories = $storage->directories;
144
    is_deeply($directories, ['one', 'one/two'], 'directories() return value is as expected');
145
146
    my $url = $storage->url('abcdef', $filepath);
147
    my $expected_url = C4::Context->preference('OPACBaseURL') . '/cgi-bin/koha/opac-retrieve-file.pl?id=abcdef';
148
    is($url, $expected_url, 'url() return value is as expected');
149
};
150
151
subtest 'external' => sub {
152
    plan tests => 8;
153
154
    my $storage = Koha::Storage->get_instance('external');
155
    isa_ok($storage, 'Koha::Storage', 'Koha::Storage->get_instance return value');
156
    is($storage->{name}, 'external', 'Koha::Storage->get_instance returns the correct instance');
157
158
    my $filepath = $storage->filepath({
159
        dir => 'one/two',
160
        hashvalue => 'abcdef',
161
        filename => 'foo.bar',
162
    });
163
    is($filepath, 'one/two/foo.bar', 'filepath is correct');
164
165
    ok(!$storage->exists($filepath), "$filepath doesn't exist yet");
166
167
    my $fh = $storage->fh($filepath, 'w');
168
    print $fh 'foo.bar content';
169
    close $fh;
170
171
    ok($storage->exists($filepath), "$filepath now exists");
172
173
    $fh = $storage->fh($filepath, 'r');
174
    my $content = <$fh>;
175
    is($content, 'foo.bar content', "$filepath content is as expected");
176
177
    my $directories = $storage->directories;
178
    is_deeply($directories, ['one', 'one/two'], 'directories() return value is as expected');
179
180
    my $url = $storage->url('abcdef', $filepath);
181
    my $expected_url = 'https://external.example.com/one/two/foo.bar';
182
    is($url, $expected_url, 'url() return value is as expected');
183
};
(-)a/t/db_dependent/ImportBatch.t (-1 / +6 lines)
Lines 172-178 my $batch3_results = $dbh->do('SELECT * FROM import_batches WHERE import_batch_i Link Here
172
is( $batch3_results, "0E0", "Batch 3 has been deleted");
172
is( $batch3_results, "0E0", "Batch 3 has been deleted");
173
173
174
subtest "RecordsFromMarcPlugin" => sub {
174
subtest "RecordsFromMarcPlugin" => sub {
175
    plan tests => 5;
175
    plan tests => 6;
176
176
177
    # Create a test file
177
    # Create a test file
178
    my ( $fh, $name ) = tempfile();
178
    my ( $fh, $name ) = tempfile();
Lines 197-202 subtest "RecordsFromMarcPlugin" => sub { Link Here
197
        'Checked one field in first record' );
197
        'Checked one field in first record' );
198
    is( $records->[1]->subfield('100', 'a'), 'Another',
198
    is( $records->[1]->subfield('100', 'a'), 'Another',
199
        'Checked one field in second record' );
199
        'Checked one field in second record' );
200
201
    open my $fh2, '<', $name;
202
    $records = C4::ImportBatch::RecordsFromMarcPlugin( $fh2, ref $plugin, 'UTF-8' );
203
    close $fh2;
204
    is( @$records, 2, 'Can take a filehandle as parameter' );
200
};
205
};
201
206
202
$schema->storage->txn_rollback;
207
$schema->storage->txn_rollback;
(-)a/t/db_dependent/Upload.t (-44 / +58 lines)
Lines 2-8 Link Here
2
2
3
use Modern::Perl;
3
use Modern::Perl;
4
use File::Temp qw/ tempdir /;
4
use File::Temp qw/ tempdir /;
5
use Test::More tests => 12;
5
use Test::More tests => 11;
6
use Test::Warn;
6
use Test::Warn;
7
7
8
use Test::MockModule;
8
use Test::MockModule;
Lines 23-56 our $builder = t::lib::TestBuilder->new; Link Here
23
our $current_upload = 0;
23
our $current_upload = 0;
24
our $uploads = [
24
our $uploads = [
25
    [
25
    [
26
        { name => 'file1', cat => 'A', size => 6000 },
26
        { name => 'file1', storage => 'DEFAULT', dir => 'A', size => 6000 },
27
        { name => 'file2', cat => 'A', size => 8000 },
27
        { name => 'file2', storage => 'DEFAULT', dir => 'A', size => 8000 },
28
    ],
28
    ],
29
    [
29
    [
30
        { name => 'file3', cat => 'B', size => 1000 },
30
        { name => 'file3', storage => 'DEFAULT', dir => 'B', size => 1000 },
31
    ],
31
    ],
32
    [
32
    [
33
        { name => 'file4', cat => undef, size => 5000 }, # temporary
33
        { name => 'file4', storage => 'TMP', dir => undef, size => 5000 },
34
    ],
34
    ],
35
    [
35
    [
36
        { name => 'file2', cat => 'A', size => 8000 },
36
        { name => 'file2', storage => 'DEFAULT', dir => 'A', size => 8000 },
37
        # uploading a duplicate in cat A should fail
37
        # uploading a duplicate in dir A should fail
38
    ],
38
    ],
39
    [
39
    [
40
        { name => 'file4', cat => undef, size => 5000 }, # temp duplicate
40
        { name => 'file4', storage => 'TMP', dir => undef, size => 5000 }, # temp duplicate
41
    ],
41
    ],
42
    [
42
    [
43
        { name => 'file5', cat => undef, size => 7000 },
43
        { name => 'file5', storage => 'DEFAULT', dir => undef, size => 7000 },
44
    ],
44
    ],
45
    [
45
    [
46
        { name => 'file6', cat => undef, size => 6500 },
46
        { name => 'file6', storage => 'TMP', dir => undef, size => 6500 },
47
        { name => 'file7', cat => undef, size => 6501 },
47
        { name => 'file7', storage => 'TMP', dir => undef, size => 6501 },
48
    ],
48
    ],
49
];
49
];
50
50
51
# Redirect upload dir structure and mock File::Spec and CGI
51
# Redirect upload dir structure and mock File::Spec and CGI
52
my $tempdir = tempdir( CLEANUP => 1 );
52
my $tempdir = tempdir( CLEANUP => 1 );
53
t::lib::Mocks::mock_config('upload_path', $tempdir);
53
my $storage_config = [
54
    {
55
        name => 'DEFAULT',
56
        adapter => 'directory',
57
        adapter_params => {
58
            path => $tempdir,
59
        },
60
        hash_filename => 1,
61
    },
62
];
63
t::lib::Mocks::mock_config('storage', $storage_config);
54
my $specmod = Test::MockModule->new( 'File::Spec' );
64
my $specmod = Test::MockModule->new( 'File::Spec' );
55
$specmod->mock( 'tmpdir' => sub { return $tempdir; } );
65
$specmod->mock( 'tmpdir' => sub { return $tempdir; } );
56
my $cgimod = Test::MockModule->new( 'CGI' );
66
my $cgimod = Test::MockModule->new( 'CGI' );
Lines 68-88 subtest 'Make a fresh start' => sub { Link Here
68
    is( Koha::UploadedFiles->count, 0, 'No records left' );
78
    is( Koha::UploadedFiles->count, 0, 'No records left' );
69
};
79
};
70
80
71
subtest 'permanent_directory and temporary_directory' => sub {
72
    plan tests => 2;
73
74
    # Check mocked directories
75
    is( Koha::UploadedFile->permanent_directory, $tempdir,
76
        'Check permanent directory' );
77
    is( Koha::UploadedFile->temporary_directory, $tempdir,
78
        'Check temporary directory' );
79
};
80
81
subtest 'Add two uploads in category A' => sub {
81
subtest 'Add two uploads in category A' => sub {
82
    plan tests => 9;
82
    plan tests => 9;
83
83
84
    my $upl = Koha::Uploader->new({
84
    my $upl = Koha::Uploader->new({
85
        category => $uploads->[$current_upload]->[0]->{cat},
85
        storage => $uploads->[$current_upload]->[0]->{storage},
86
        dir => $uploads->[$current_upload]->[0]->{dir},
86
    });
87
    });
87
    my $cgi= $upl->cgi;
88
    my $cgi= $upl->cgi;
88
    my $res= $upl->result;
89
    my $res= $upl->result;
Lines 95-120 subtest 'Add two uploads in category A' => sub { Link Here
95
    }, { order_by => { -asc => 'filename' }});
96
    }, { order_by => { -asc => 'filename' }});
96
    my $rec = $rs->next;
97
    my $rec = $rs->next;
97
    is( $rec->filename, 'file1', 'Check file name' );
98
    is( $rec->filename, 'file1', 'Check file name' );
98
    is( $rec->uploadcategorycode, 'A', 'Check category A' );
99
    is( $rec->dir, 'A', 'Check dir A' );
99
    is( $rec->filesize, 6000, 'Check size of file1' );
100
    is( $rec->filesize, 6000, 'Check size of file1' );
100
    $rec = $rs->next;
101
    $rec = $rs->next;
101
    is( $rec->filename, 'file2', 'Check file name 2' );
102
    is( $rec->filename, 'file2', 'Check file name 2' );
102
    is( $rec->filesize, 8000, 'Check size of file2' );
103
    is( $rec->filesize, 8000, 'Check size of file2' );
103
    is( $rec->public, undef, 'Check public undefined' );
104
    is( $rec->public, 0, 'Check public 0' );
104
};
105
};
105
106
106
subtest 'Add another upload, check file_handle' => sub {
107
subtest 'Add another upload, check file_handle' => sub {
107
    plan tests => 5;
108
    plan tests => 5;
108
109
109
    my $upl = Koha::Uploader->new({
110
    my $upl = Koha::Uploader->new({
110
        category => $uploads->[$current_upload]->[0]->{cat},
111
        storage => $uploads->[$current_upload]->[0]->{storage},
112
        dir => $uploads->[$current_upload]->[0]->{dir},
111
        public => 1,
113
        public => 1,
112
    });
114
    });
113
    my $cgi= $upl->cgi;
115
    my $cgi= $upl->cgi;
114
    is( $upl->count, 1, 'Upload 2 includes one file' );
116
    is( $upl->count, 1, 'Upload 2 includes one file' );
115
    my $res= $upl->result;
117
    my $res= $upl->result;
116
    my $rec = Koha::UploadedFiles->find( $res );
118
    my $rec = Koha::UploadedFiles->find( $res );
117
    is( $rec->uploadcategorycode, 'B', 'Check category B' );
119
    is( $rec->dir, 'B', 'Check dir B' );
118
    is( $rec->public, 1, 'Check public == 1' );
120
    is( $rec->public, 1, 'Check public == 1' );
119
    my $fh = $rec->file_handle;
121
    my $fh = $rec->file_handle;
120
    is( ref($fh) eq 'IO::File' && $fh->opened, 1, 'Get returns a file handle' );
122
    is( ref($fh) eq 'IO::File' && $fh->opened, 1, 'Get returns a file handle' );
Lines 128-145 subtest 'Add another upload, check file_handle' => sub { Link Here
128
subtest 'Add temporary upload' => sub {
130
subtest 'Add temporary upload' => sub {
129
    plan tests => 2;
131
    plan tests => 2;
130
132
131
    my $upl = Koha::Uploader->new({ tmp => 1 }); #temporary
133
    my $upl = Koha::Uploader->new({
134
        storage => $uploads->[$current_upload]->[0]->{storage},
135
        dir => $uploads->[$current_upload]->[0]->{dir},
136
    });
132
    my $cgi= $upl->cgi;
137
    my $cgi= $upl->cgi;
133
    is( $upl->count, 1, 'Upload 3 includes one temporary file' );
138
    is( $upl->count, 1, 'Upload 3 includes one temporary file' );
134
    my $rec = Koha::UploadedFiles->find( $upl->result );
139
    my $rec = Koha::UploadedFiles->find( $upl->result );
135
    is( $rec->uploadcategorycode =~ /_upload$/, 1, 'Check category temp file' );
140
    is( $rec->dir, '', 'Check dir is empty' );
136
};
141
};
137
142
138
subtest 'Add same file in same category' => sub {
143
subtest 'Add same file in same category' => sub {
139
    plan tests => 3;
144
    plan tests => 3;
140
145
141
    my $upl = Koha::Uploader->new({
146
    my $upl = Koha::Uploader->new({
142
        category => $uploads->[$current_upload]->[0]->{cat},
147
        storage => $uploads->[$current_upload]->[0]->{storage},
148
        dir => $uploads->[$current_upload]->[0]->{dir},
143
    });
149
    });
144
    my $cgi= $upl->cgi;
150
    my $cgi= $upl->cgi;
145
    is( $upl->count, 0, 'Upload 4 failed as expected' );
151
    is( $upl->count, 0, 'Upload 4 failed as expected' );
Lines 152-182 subtest 'Test delete via UploadedFile as well as UploadedFiles' => sub { Link Here
152
    plan tests => 10;
158
    plan tests => 10;
153
159
154
    # add temporary file with same name and contents (file4)
160
    # add temporary file with same name and contents (file4)
155
    my $upl = Koha::Uploader->new({ tmp => 1 });
161
    my $upl = Koha::Uploader->new({
162
        storage => $uploads->[$current_upload]->[0]->{storage},
163
        dir => $uploads->[$current_upload]->[0]->{dir},
164
    });
156
    my $cgi= $upl->cgi;
165
    my $cgi= $upl->cgi;
157
    is( $upl->count, 1, 'Add duplicate temporary file (file4)' );
166
    is( $upl->count, 1, 'Add duplicate temporary file (file4)' );
158
    my $id = $upl->result;
167
    my $id = $upl->result;
159
    my $path = Koha::UploadedFiles->find( $id )->full_path;
168
    my $uploaded_file = Koha::UploadedFiles->find( $id );
169
    my $storage = Koha::Storage->get_instance($uploaded_file->storage);
160
170
161
    # testing delete via UploadedFiles (plural)
171
    # testing delete via UploadedFiles (plural)
162
    my $delete = Koha::UploadedFiles->search({ id => $id })->delete;
172
    my $delete = Koha::UploadedFiles->search({ id => $id })->delete;
163
    isnt( $delete, "0E0", 'Delete successful' );
173
    isnt( $delete, "0E0", 'Delete successful' );
164
    isnt( -e $path, 1, 'File no longer found after delete' );
174
    isnt( $storage->exists($uploaded_file->filepath), 1, 'File no longer found after delete' );
165
    is( Koha::UploadedFiles->find( $id ), undef, 'Record also gone' );
175
    is( Koha::UploadedFiles->find( $id ), undef, 'Record also gone' );
166
176
167
    # testing delete via UploadedFile (singular)
177
    # testing delete via UploadedFile (singular)
168
    # Note that find returns a Koha::Object
178
    # Note that find returns a Koha::Object
169
    $upl = Koha::Uploader->new({ tmp => 1 });
179
    $upl = Koha::Uploader->new({
180
        storage => $uploads->[$current_upload]->[0]->{storage},
181
        dir => $uploads->[$current_upload]->[0]->{dir},
182
    });
170
    $upl->cgi;
183
    $upl->cgi;
171
    my $kohaobj = Koha::UploadedFiles->find( $upl->result );
184
    my $kohaobj = Koha::UploadedFiles->find( $upl->result );
172
    $path = $kohaobj->full_path;
185
    $storage = Koha::Storage->get_instance($kohaobj->storage);
173
    $delete = $kohaobj->delete;
186
    $delete = $kohaobj->delete;
174
    ok( $delete=~/^-?1$/, 'Delete successful' );
187
    ok( $delete=~/^-?1$/, 'Delete successful' );
175
    isnt( -e $path, 1, 'File no longer found after delete' );
188
    isnt($storage->exists($kohaobj->filepath), 1, 'File no longer found after delete' );
176
189
177
    # add another record with TestBuilder, so file does not exist
190
    # add another record with TestBuilder, so file does not exist
178
    # catch warning
191
    # catch warning
179
    my $upload01 = $builder->build({ source => 'UploadedFile' });
192
    my $upload01 = $builder->build({ source => 'UploadedFile', value => {storage => 'TMP'} });
180
    warning_like { $delete = Koha::UploadedFiles->find( $upload01->{id} )->delete; }
193
    warning_like { $delete = Koha::UploadedFiles->find( $upload01->{id} )->delete; }
181
        qr/file was missing/,
194
        qr/file was missing/,
182
        'delete warns when file is missing';
195
        'delete warns when file is missing';
Lines 196-203 subtest 'Test delete_missing' => sub { Link Here
196
    plan tests => 5;
209
    plan tests => 5;
197
210
198
    # If we add files via TestBuilder, they do not exist
211
    # If we add files via TestBuilder, they do not exist
199
    my $upload01 = $builder->build({ source => 'UploadedFile' });
212
    my $upload01 = $builder->build({ source => 'UploadedFile', value => {storage => 'TMP'} });
200
    my $upload02 = $builder->build({ source => 'UploadedFile' });
213
    my $upload02 = $builder->build({ source => 'UploadedFile', value => {storage => 'TMP'} });
201
    # dry run first
214
    # dry run first
202
    my $deleted = Koha::UploadedFiles->delete_missing({ keep_record => 1 });
215
    my $deleted = Koha::UploadedFiles->delete_missing({ keep_record => 1 });
203
    is( $deleted, 2, 'Expect two records with missing files' );
216
    is( $deleted, 2, 'Expect two records with missing files' );
Lines 224-238 subtest 'Call search_term with[out] private flag' => sub { Link Here
224
    })->count, 4, 'Returns now four results' );
237
    })->count, 4, 'Returns now four results' );
225
};
238
};
226
239
227
subtest 'Simple tests for httpheaders and getCategories' => sub {
240
subtest 'Simple tests for httpheaders' => sub {
228
    plan tests => 2;
241
    plan tests => 1;
229
242
230
    my $rec = Koha::UploadedFiles->search_term({ term => 'file' })->next;
243
    my $rec = Koha::UploadedFiles->search_term({ term => 'file' })->next;
231
    my @hdrs = $rec->httpheaders;
244
    my @hdrs = $rec->httpheaders;
232
    is( @hdrs == 4 && $hdrs[1] =~ /application\/octet-stream/, 1, 'Simple test for httpheaders');
245
    is( @hdrs == 4 && $hdrs[1] =~ /application\/octet-stream/, 1, 'Simple test for httpheaders');
233
    $builder->build({ source => 'AuthorisedValue', value => { category => 'UPLOAD', authorised_value => 'HAVE_AT_LEAST_ONE', lib => 'Hi there' } });
246
    $builder->build({ source => 'AuthorisedValue', value => { category => 'UPLOAD', authorised_value => 'HAVE_AT_LEAST_ONE', lib => 'Hi there' } });
234
    my $cat = Koha::UploadedFiles->getCategories;
235
    is( @$cat >= 1, 1, 'getCategories returned at least one category' );
236
};
247
};
237
248
238
subtest 'Testing allows_add_by' => sub {
249
subtest 'Testing allows_add_by' => sub {
Lines 277-283 subtest 'Testing delete_temporary' => sub { Link Here
277
    plan tests => 9;
288
    plan tests => 9;
278
289
279
    # Add two temporary files: result should be 3 + 3
290
    # Add two temporary files: result should be 3 + 3
280
    Koha::Uploader->new({ tmp => 1 })->cgi; # add file6 and file7
291
    Koha::Uploader->new({
292
        storage => $uploads->[$current_upload]->[0]->{storage},
293
        dir => $uploads->[$current_upload]->[0]->{dir},
294
    })->cgi; # add file6 and file7
281
    is( Koha::UploadedFiles->search->count, 6, 'Test starting count' );
295
    is( Koha::UploadedFiles->search->count, 6, 'Test starting count' );
282
    is( Koha::UploadedFiles->search({ permanent => 1 })->count, 3,
296
    is( Koha::UploadedFiles->search({ permanent => 1 })->count, 3,
283
        'Includes 3 permanent' );
297
        'Includes 3 permanent' );
(-)a/tools/stage-marc-import.pl (-4 / +5 lines)
Lines 85-101 if ($completedJobID) { Link Here
85
    $template->param(map { $_ => $results->{$_} } keys %{ $results });
85
    $template->param(map { $_ => $results->{$_} } keys %{ $results });
86
} elsif ($fileID) {
86
} elsif ($fileID) {
87
    my $upload = Koha::UploadedFiles->find( $fileID );
87
    my $upload = Koha::UploadedFiles->find( $fileID );
88
    my $file = $upload->full_path;
88
    my $storage = Koha::Storage->get_instance($upload->storage);
89
    my $fh = $storage->fh($upload->filepath, 'r');
89
    my $filename = $upload->filename;
90
    my $filename = $upload->filename;
90
91
91
    my ( $errors, $marcrecords );
92
    my ( $errors, $marcrecords );
92
    if( $format eq 'MARCXML' ) {
93
    if( $format eq 'MARCXML' ) {
93
        ( $errors, $marcrecords ) = C4::ImportBatch::RecordsFromMARCXMLFile( $file, $encoding);
94
        ( $errors, $marcrecords ) = C4::ImportBatch::RecordsFromMARCXMLFile( $fh, $encoding);
94
    } elsif( $format eq 'ISO2709' ) {
95
    } elsif( $format eq 'ISO2709' ) {
95
        ( $errors, $marcrecords ) = C4::ImportBatch::RecordsFromISO2709File( $file, $record_type, $encoding );
96
        ( $errors, $marcrecords ) = C4::ImportBatch::RecordsFromISO2709File( $fh, $record_type, $encoding );
96
    } else { # plugin based
97
    } else { # plugin based
97
        $errors = [];
98
        $errors = [];
98
        $marcrecords = C4::ImportBatch::RecordsFromMarcPlugin( $file, $format, $encoding );
99
        $marcrecords = C4::ImportBatch::RecordsFromMarcPlugin( $fh, $format, $encoding );
99
    }
100
    }
100
    warn "$filename: " . ( join ',', @$errors ) if @$errors;
101
    warn "$filename: " . ( join ',', @$errors ) if @$errors;
101
        # no need to exit if we have no records (or only errors) here
102
        # no need to exit if we have no records (or only errors) here
(-)a/tools/upload-cover-image.pl (-2 / +8 lines)
Lines 40-45 resized, maintaining aspect ratio. Link Here
40
use strict;
40
use strict;
41
use warnings;
41
use warnings;
42
42
43
use Archive::Zip qw(:ERROR_CODES);
43
use File::Temp;
44
use File::Temp;
44
use CGI qw ( -utf8 );
45
use CGI qw ( -utf8 );
45
use GD;
46
use GD;
Lines 103-111 if ($fileID) { Link Here
103
        undef $srcimage;
104
        undef $srcimage;
104
    }
105
    }
105
    else {
106
    else {
106
        my $filename = $upload->full_path;
107
        my $storage = Koha::Storage->get_instance($upload->storage);
108
        my $fh = $storage->fh($upload->filepath, 'r');
107
        my $dirname = File::Temp::tempdir( CLEANUP => 1 );
109
        my $dirname = File::Temp::tempdir( CLEANUP => 1 );
108
        unless ( system( "unzip", $filename, '-d', $dirname ) == 0 ) {
110
        my $zip = Archive::Zip->new();
111
        $zip->readFromFileHandle($fh);
112
        unless (AZ_OK == $zip->extractTree(undef, $dirname)) {
109
            $error = 'UZIPFAIL';
113
            $error = 'UZIPFAIL';
110
        }
114
        }
111
        else {
115
        else {
Lines 145-150 if ($fileID) { Link Here
145
                            $error = 'DELERR';
149
                            $error = 'DELERR';
146
                        }
150
                        }
147
                        else {
151
                        else {
152
                            my $filename;
148
                            ( $biblionumber, $filename ) = split $delim, $line, 2;
153
                            ( $biblionumber, $filename ) = split $delim, $line, 2;
149
                            $biblionumber =~
154
                            $biblionumber =~
150
                              s/[\"\r\n]//g;    # remove offensive characters
155
                              s/[\"\r\n]//g;    # remove offensive characters
Lines 177-182 if ($fileID) { Link Here
177
                }
182
                }
178
            }
183
            }
179
        }
184
        }
185
        close $fh;
180
    }
186
    }
181
    $template->{VARS}->{'total'}        = $total;
187
    $template->{VARS}->{'total'}        = $total;
182
    $template->{VARS}->{'uploadimage'}  = 1;
188
    $template->{VARS}->{'uploadimage'}  = 1;
(-)a/tools/upload-file.pl (-15 / +1 lines)
Lines 48-54 if( $auth_status ne 'ok' || !$allowed ) { Link Here
48
    exit 0;
48
    exit 0;
49
}
49
}
50
50
51
my $upload = Koha::Uploader->new( upload_pars($ENV{QUERY_STRING}) );
51
my $upload = Koha::Uploader->new( { CGI->new($ENV{QUERY_STRING})->Vars } );
52
if( !$upload || !$upload->cgi || !$upload->count ) {
52
if( !$upload || !$upload->cgi || !$upload->count ) {
53
    # not one upload succeeded
53
    # not one upload succeeded
54
    send_reply( 'failed', undef, $upload? $upload->err: undef );
54
    send_reply( 'failed', undef, $upload? $upload->err: undef );
Lines 68-84 sub send_reply { # response will be sent back as JSON Link Here
68
        errors => $error,
68
        errors => $error,
69
   });
69
   });
70
}
70
}
71
72
sub upload_pars { # this sub parses QUERY_STRING in order to build the
73
                  # parameter hash for Koha::Uploader
74
    my ( $qstr ) = @_;
75
    $qstr = Encode::decode_utf8( uri_unescape( $qstr ) );
76
    # category could include a utf8 character
77
    my $rv = {};
78
    foreach my $p ( qw[public category temp] ) {
79
        if( $qstr =~ /(^|&)$p=(\w+)(&|$)/ ) {
80
            $rv->{$p} = $2;
81
        }
82
    }
83
    return $rv;
84
}
(-)a/tools/upload.pl (-6 / +14 lines)
Lines 22-28 use CGI qw/-utf8/; Link Here
22
use JSON;
22
use JSON;
23
23
24
use C4::Auth;
24
use C4::Auth;
25
use C4::Context;
25
use C4::Output;
26
use C4::Output;
27
use Koha::Storage;
26
use Koha::UploadedFiles;
28
use Koha::UploadedFiles;
27
29
28
my $input  = CGI::->new;
30
my $input  = CGI::->new;
Lines 42-52 my ( $template, $loggedinuser, $cookie ) = get_template_and_user( Link Here
42
    }
44
    }
43
);
45
);
44
46
47
my @storages;
48
foreach my $config (@{ Koha::Storage->config }) {
49
    my $storage = Koha::Storage->get_instance($config->{name});
50
    push @storages, $storage if $storage;
51
}
52
45
$template->param(
53
$template->param(
46
    index      => $index,
54
    index      => $index,
47
    owner      => $loggedinuser,
55
    owner      => $loggedinuser,
48
    plugin     => $plugin,
56
    plugin     => $plugin,
49
    uploadcategories => Koha::UploadedFiles->getCategories,
57
    storages   => \@storages,
50
);
58
);
51
59
52
if ( $op eq 'new' ) {
60
if ( $op eq 'new' ) {
Lines 59-71 if ( $op eq 'new' ) { Link Here
59
    my $uploads;
67
    my $uploads;
60
    if( $id ) {
68
    if( $id ) {
61
        my $rec = Koha::UploadedFiles->find( $id );
69
        my $rec = Koha::UploadedFiles->find( $id );
62
        undef $rec if $rec && $plugin && !$rec->public;
70
        if ($rec && (!$plugin || $rec->public)) {
63
        push @$uploads, $rec->unblessed if $rec;
71
            push @$uploads, $rec;
72
        }
64
    } else {
73
    } else {
65
        $uploads = Koha::UploadedFiles->search_term({
74
        $uploads = [ Koha::UploadedFiles->search_term({
66
            term => $term,
75
            term => $term,
67
            $plugin? (): ( include_private => 1 ),
76
            $plugin? (): ( include_private => 1 ),
68
        })->unblessed;
77
        }) ];
69
    }
78
    }
70
79
71
    $template->param(
80
    $template->param(
72
- 

Return to bug 19318