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

(-)a/C4/ImportBatch.pm (-5 / +22 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 1510-1516 sub SetImportRecordMatches { Link Here
1510
1512
1511
Reads ISO2709 binary porridge from the given file and creates MARC::Record-objects out of it.
1513
Reads ISO2709 binary porridge from the given file and creates MARC::Record-objects out of it.
1512
1514
1513
@PARAM1, String, absolute path to the ISO2709 file.
1515
@PARAM1, String, absolute path to the ISO2709 file or an open filehandle.
1514
@PARAM2, String, see stage_file.pl
1516
@PARAM2, String, see stage_file.pl
1515
@PARAM3, String, should be utf8
1517
@PARAM3, String, should be utf8
1516
1518
Lines 1525-1531 sub RecordsFromISO2709File { Link Here
1525
    my $marc_type = C4::Context->preference('marcflavour');
1527
    my $marc_type = C4::Context->preference('marcflavour');
1526
    $marc_type .= 'AUTH' if ($marc_type eq 'UNIMARC' && $record_type eq 'auth');
1528
    $marc_type .= 'AUTH' if ($marc_type eq 'UNIMARC' && $record_type eq 'auth');
1527
1529
1528
    open my $fh, '<', $input_file or die "$0: cannot open input file $input_file: $!\n";
1530
    my $fh;
1531
    if (openhandle($input_file)) {
1532
        $fh = $input_file;
1533
    } else {
1534
        open $fh, '<', $input_file or die "$0: cannot open input file $input_file: $!\n";
1535
    }
1536
1529
    my @marc_records;
1537
    my @marc_records;
1530
    $/ = "\035";
1538
    $/ = "\035";
1531
    while (<$fh>) {
1539
    while (<$fh>) {
Lines 1541-1546 sub RecordsFromISO2709File { Link Here
1541
        }
1549
        }
1542
    }
1550
    }
1543
    close $fh;
1551
    close $fh;
1552
1544
    return ( \@errors, \@marc_records );
1553
    return ( \@errors, \@marc_records );
1545
}
1554
}
1546
1555
Lines 1550-1556 sub RecordsFromISO2709File { Link Here
1550
1559
1551
Creates MARC::Record-objects out of the given MARCXML-file.
1560
Creates MARC::Record-objects out of the given MARCXML-file.
1552
1561
1553
@PARAM1, String, absolute path to the ISO2709 file.
1562
@PARAM1, String, absolute path to the ISO2709 file or an open filehandle
1554
@PARAM2, String, should be utf8
1563
@PARAM2, String, should be utf8
1555
1564
1556
Returns two array refs.
1565
Returns two array refs.
Lines 1573-1579 sub RecordsFromMARCXMLFile { Link Here
1573
1582
1574
=head2 RecordsFromMarcPlugin
1583
=head2 RecordsFromMarcPlugin
1575
1584
1576
    Converts text of input_file into array of MARC records with to_marc plugin
1585
Converts text of C<$input_file> into array of MARC records with to_marc plugin
1586
1587
C<$input_file> can be either a filename or an open filehandle.
1577
1588
1578
=cut
1589
=cut
1579
1590
Lines 1583-1589 sub RecordsFromMarcPlugin { Link Here
1583
    return \@return if !$input_file || !$plugin_class;
1594
    return \@return if !$input_file || !$plugin_class;
1584
1595
1585
    # Read input file
1596
    # Read input file
1586
    open my $fh, '<', $input_file or die "$0: cannot open input file $input_file: $!\n";
1597
    my $fh;
1598
    if (openhandle($input_file)) {
1599
        $fh = $input_file;
1600
    } else {
1601
        open $fh, '<', $input_file or die "$0: cannot open input file $input_file: $!\n";
1602
    }
1603
1587
    $/ = "\035";
1604
    $/ = "\035";
1588
    while (<$fh>) {
1605
    while (<$fh>) {
1589
        s/^\s+//;
1606
        s/^\s+//;
(-)a/Koha/Storage.pm (+365 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, see <http://www.gnu.org/licenses>.
18
19
=head1 NAME
20
21
Koha::Storage - Manage file storages
22
23
=head1 SYNOPSIS
24
25
    use Koha::Storage;
26
27
    # Get all available storages
28
    my $config = Koha::Storage->config;
29
30
    # Get storage instance by name
31
    # By default, 'TMP' and 'DEFAULT' are available
32
    # Others can be added in $KOHA_CONF
33
    my $storage = Koha::Storage->get_instance($name)
34
35
    my $directories = $storage->directories();
36
37
    my $filepath = $storage->filepath({
38
        hashvalue => $hashvalue,
39
        filename => $filename,
40
        dir => $dir,
41
    });
42
43
    my $exists = $storage->exists($filepath);
44
    my $deleted_count = $storage->delete($filepath);
45
46
    my $fh = $storage->fh($filepath, $mode);
47
48
    my $url = $storage->url($hashfile, $filepath);
49
50
=cut
51
52
use Modern::Perl;
53
54
use File::Spec;
55
use List::Util qw( first );
56
57
use C4::Context;
58
59
use constant KOHA_UPLOAD => 'koha_upload';
60
61
=head1 CLASS METHODS
62
63
=head2 config
64
65
Returns the configuration for all available storages.
66
67
    my $config = Koha::Storage->config
68
69
Returns an arrayref containing hashrefs. Example:
70
71
    [
72
        {
73
            name => 'TMP',
74
            adapter => 'directory',
75
            adapter_params => {
76
                path => '/tmp',
77
            },
78
            temporary => 1,
79
            hash_filename => 1,
80
        },
81
        {
82
            name => 'DEFAULT',
83
            ...
84
        },
85
        ...
86
    ]
87
88
Storages can be configured in C<$KOHA_CONF> by adding <storage> elements:
89
90
    <yazgfs>
91
        <config>
92
            <storage>
93
                <!-- Mandatory: Storage's identifier -->
94
                <name>MyStorage</name>
95
96
                <!-- Mandatory: 'directory' is the only available adapter actually -->
97
                <adapter>directory</adapter>
98
99
100
                <!-- Parameters specific to storage's adapter -->
101
                <adapter_params>
102
                    <!-- Mandatory for 'directory' adapter -->
103
                    <path>/mnt/mystorage</path>
104
                </adapter_params>
105
106
                <!-- Whether or not to prepend the hashvalue to filename -->
107
                <!-- Default: 0 -->
108
                <hash_filename>1</hash_filename>
109
110
                <!-- Whether or not the storage is temporary -->
111
                <!-- Default: 0 -->
112
                <temporary>0</temporary>
113
114
                <!-- If a baseurl is set, the file's URL is built by concatenating the baseurl and the filepath -->
115
                <!-- Otherwise it falls back to using opac-retrieve-file.pl -->
116
                <baseurl>https://mystorage.example.com/</baseurl>
117
            </storage>
118
            <!-- ... -->
119
        </config>
120
    </yazgfs>
121
122
The 'TMP' storage is always available and cannot be configured.
123
124
The 'DEFAULT' storage is available if:
125
126
=over
127
128
=item * C<upload_path> is set in C<$KOHA_CONF>, or
129
130
=item * a storage named 'DEFAULT' is configured in C<$KOHA_CONF>
131
132
=back
133
134
=cut
135
136
sub config {
137
    my $storage = C4::Context->config('storage');
138
139
    my $config;
140
    if (ref $storage eq 'ARRAY') {
141
        $config = [ @$storage ];
142
    } elsif ($storage) {
143
        $config = [ $storage ];
144
    } else {
145
        $config = [];
146
    }
147
148
    my $default = first { $_->{name} eq 'DEFAULT' } @$config;
149
    unless ($default) {
150
        # Backward compatibility for those who haven't changed their $KOHA_CONF
151
        warn "No 'DEFAULT' storage configured. Using upload_path as a fallback.";
152
153
        my $upload_path = C4::Context->config('upload_path');
154
        if ($upload_path) {
155
            unshift @$config, {
156
                name => 'DEFAULT',
157
                adapter => 'directory',
158
                adapter_params => {
159
                    path => C4::Context->config('upload_path'),
160
                },
161
                hash_filename => 1,
162
            };
163
        } else {
164
            warn "No upload_path defined."
165
        }
166
    }
167
168
    my $database = C4::Context->config('database');
169
    my $subdir = KOHA_UPLOAD =~ s/koha/$database/r;
170
    unshift @$config, {
171
        name => 'TMP',
172
        adapter => 'directory',
173
        adapter_params => {
174
            path => File::Spec->catfile(File::Spec->tmpdir, $subdir),
175
        },
176
        temporary => 1,
177
        hash_filename => 1,
178
    };
179
180
    return $config;
181
}
182
183
=head2 get_instance
184
185
Retrieves an instance of Koha::Storage
186
187
    my $storage = Koha::Storage->get_instance($name);
188
189
Returns a Koha::Storage object
190
191
=cut
192
193
my $instances = {};
194
195
sub get_instance {
196
    my ($class, $name) = @_;
197
198
    unless (exists $instances->{$name}) {
199
        my $storages = $class->config;
200
        my $storage = first { $_->{name} eq $name } @$storages;
201
202
        if ($storage) {
203
            $instances->{$name} = $class->new($storage);
204
        } else {
205
            warn "There is no storage named $name";
206
        }
207
    }
208
209
    return $instances->{$name};
210
}
211
212
=head2 new
213
214
Creates a new Koha::Storage object
215
216
    my $storage = Koha::Storage->new(\%params);
217
218
C<%params> can contain the same keys as the one returned by C<Koha::Storage-E<gt>config>
219
220
You shouldn't use this directly. Use C<Koha::Storage-E<gt>get_instance> instead
221
222
=cut
223
224
sub new {
225
    my ($class, $params) = @_;
226
227
    my $adapter_class = 'Koha::Storage::Adapter::' . ucfirst(lc($params->{adapter}));
228
    my $adapter;
229
    eval {
230
        my $adapter_file = $adapter_class =~ s,::,/,gr . '.pm';
231
        require $adapter_file;
232
        $adapter = $adapter_class->new($params->{adapter_params});
233
    };
234
    if ($@) {
235
        warn "Unable to create an instance of $adapter_class : $@";
236
237
        return;
238
    }
239
240
    my $self = $params;
241
    $self->{adapter} = $adapter;
242
243
    return bless $self, $class;
244
}
245
246
=head1 INSTANCE METHODS
247
248
=head2 filepath
249
250
Returns relative filepath of a file according to storage's parameters and file's
251
properties (filename, hashvalue, dir)
252
253
    my $filepath = $storage->filepath({
254
        hashvalue => $hashvalue,
255
        filename => $filename,
256
        dir => $dir,
257
    })
258
259
The return value is a required parameter for several other methods.
260
261
=cut
262
263
sub filepath {
264
    my ($self, $params) = @_;
265
266
    my $filepath;
267
    if ($params->{dir}) {
268
        $filepath .= $params->{dir} . '/';
269
    }
270
    if ($params->{hashvalue} && $self->{hash_filename}) {
271
        $filepath .= $params->{hashvalue} . '_';
272
    }
273
    $filepath .= $params->{filename};
274
275
    return $filepath;
276
}
277
278
=head2 exists
279
280
Check file existence
281
282
    my $filepath = $storage->filepath(\%params);
283
    my $exists = $storage->exists($filepath);
284
285
Returns a true value if the file exists, and a false value otherwise.
286
287
=cut
288
289
sub exists {
290
    my ($self, $filepath) = @_;
291
292
    return $self->{adapter}->exists($filepath);
293
}
294
295
=head2 fh
296
297
Returns a file handle for the given C<$filepath>
298
299
    my $filepath = $storage->filepath(\%params);
300
    my $fh = $storage->fh($filepath, $mode);
301
302
For possible values of C<$mode>, see L<perlfunc/open>
303
304
=cut
305
306
sub fh {
307
    my ($self, $filepath, $mode) = @_;
308
309
    return $self->{adapter}->fh($filepath, $mode);
310
}
311
312
=head2 directories
313
314
Returns a list of writable directories in storage
315
316
    my $directories = $storage->directories();
317
318
=cut
319
320
sub directories {
321
    my ($self) = @_;
322
323
    return $self->{adapter}->directories();
324
}
325
326
=head2 delete
327
328
Deletes a file
329
330
    my $filepath = $storage->filepath(\%params);
331
    $storage->delete($filepath);
332
333
=cut
334
335
sub delete {
336
    my ($self, $filepath) = @_;
337
338
    return $self->{adapter}->delete($filepath);
339
}
340
341
=head2 url
342
343
Returns the URL to access the file
344
345
    my $filepath = $storage->filepath(\%params);
346
    my $url = $storage->url($hashvalue, $filepath);
347
348
=cut
349
350
sub url {
351
    my ($self, $hashvalue, $filepath) = @_;
352
353
    if ($self->{baseurl}) {
354
        return $self->{baseurl} . $filepath;
355
    }
356
357
    # Default to opac-retrieve-file.pl
358
    my $url = C4::Context->preference('OPACBaseURL');
359
    $url =~ s/\/$//;
360
    $url .= '/cgi-bin/koha/opac-retrieve-file.pl?id=' . $hashvalue;
361
362
    return $url;
363
}
364
365
1;
(-)a/Koha/Storage/Adapter/Directory.pm (+173 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, if not, see <http://www.gnu.org/licenses>.
18
19
=head1 NAME
20
21
Koha::Storage::Adapter::Directory - Storage adapter for a filesystem directory
22
23
=head1 DESCRIPTION
24
25
This is the default storage adapter. It stores files in a directory on the
26
filesystem.
27
28
You shouldn't use this directly. Use C<Koha::Storage> instead.
29
30
=cut
31
32
use Modern::Perl;
33
34
use File::Basename;
35
use File::Find;
36
use File::Path qw(make_path);
37
use File::Spec;
38
use IO::File;
39
40
=head1 INSTANCE METHODS
41
42
=head2 new
43
44
Creates a new C<Koha::Storage::Adapter::Directory> object.
45
46
    my $adapter = Koha::Storage::Adapter::Directory->new(\%params):
47
48
C<%params> contains the following keys:
49
50
=over
51
52
=item * C<path>: Mandatory. Absolute path of storage
53
54
=back
55
56
=cut
57
58
sub new {
59
    my ($class, $params) = @_;
60
61
    unless ($params->{path}) {
62
        die "Missing parameter 'path'";
63
    }
64
65
    my $self = { %$params };
66
67
    return bless $self, $class;
68
}
69
70
=head2 exists
71
72
See L<Koha::Storage/exists>.
73
74
=cut
75
76
sub exists {
77
    my ($self, $filepath) = @_;
78
79
    return -e $self->abspath($filepath);
80
}
81
82
=head2 fh
83
84
See L<Koha::Storage/fh>.
85
86
=cut
87
88
sub fh {
89
    my ($self, $filepath, $mode) = @_;
90
91
    my $abspath = $self->abspath($filepath);
92
93
    my $dirname = dirname($abspath);
94
    unless (-e $dirname) {
95
        eval {
96
            make_path($dirname);
97
        };
98
        if ($@) {
99
            warn "Unable to create path $dirname: $@";
100
            return;
101
        }
102
    }
103
104
    unless (-w $dirname) {
105
        warn "Directory $dirname is not writable";
106
        return;
107
    }
108
109
    my $fh = IO::File->new($abspath, $mode);
110
    unless ($fh) {
111
        warn "File handle creation failed for $abspath (mode $mode)";
112
        return;
113
    }
114
115
    $fh->binmode;
116
117
    return $fh;
118
}
119
120
=head2 directories
121
122
See L<Koha::Storage/directories>.
123
124
=cut
125
126
sub directories {
127
    my ($self) = @_;
128
129
    my @directories;
130
131
    if (-e $self->{path}) {
132
        find(sub {
133
            if (-d $File::Find::name) {
134
                my $relpath = $File::Find::name =~ s/^\Q$self->{path}\E\/?//r;
135
                push @directories, $relpath if $relpath;
136
            }
137
        }, $self->{path});
138
    }
139
140
    return \@directories;
141
}
142
143
=head2 delete
144
145
See L<Koha::Storage/delete>.
146
147
=cut
148
149
sub delete {
150
    my ($self, $filepath) = @_;
151
152
    return unlink $self->abspath($filepath);
153
}
154
155
=head1 INTERNAL METHODS
156
157
=head2 abspath
158
159
Returns the absolute path of a file
160
161
    my $abspath = $adapter->abspath($filepath);
162
163
=cut
164
165
sub abspath {
166
    my ($self, $filepath) = @_;
167
168
    my $abspath = File::Spec->catfile($self->{path}, $filepath);
169
170
    return $abspath;
171
}
172
173
1;
(-)a/Koha/UploadedFile.pm (-41 / +48 lines)
Lines 18-26 package Koha::UploadedFile; Link Here
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
19
20
use Modern::Perl;
20
use Modern::Perl;
21
use File::Spec;
22
21
23
use parent qw(Koha::Object);
22
use Koha::Storage;
23
24
use base qw(Koha::Object);
24
25
25
=head1 NAME
26
=head1 NAME
26
27
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-107 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
    return $retval if $params->{keep_file};
74
    return $retval if $params->{keep_file};
79
75
80
    if( ! -e $file ) {
76
    my $storage = Koha::Storage->get_instance($self->storage);
81
        warn "Removing record for $name within category ".
77
    my $filepath = $self->filepath;
82
            $self->uploadcategorycode. ", but file was missing.";
83
    } elsif( ! unlink($file) ) {
84
        warn "Problem while deleting: $file";
85
    }
86
    return $retval;
87
}
88
89
=head3 full_path
90
91
Returns the fully qualified path name for an uploaded file.
92
78
93
=cut
79
    if ( ! $storage->exists($filepath) ) {
80
        warn "Removing record for $name within storage " . $self->storage . ", but file was missing.";
81
    } elsif ( ! $storage->delete($filepath) ) {
82
        warn "Problem while deleting: $filepath";
83
    }
94
84
95
sub full_path {
85
    return $retval;
96
    my ( $self ) = @_;
97
    my $path = File::Spec->catfile(
98
        $self->permanent
99
            ? $self->permanent_directory
100
            : C4::Context->temporary_directory,
101
        $self->dir,
102
        $self->hashvalue. '_'. $self->filename,
103
    );
104
    return $path;
105
}
86
}
106
87
107
=head3 file_handle
88
=head3 file_handle
Lines 112-121 Returns a file handle for an uploaded file. Link Here
112
93
113
sub file_handle {
94
sub file_handle {
114
    my ( $self ) = @_;
95
    my ( $self ) = @_;
115
    $self->{_file_handle} = IO::File->new( $self->full_path, "r" );
96
116
    return if !$self->{_file_handle};
97
    my $storage = Koha::Storage->get_instance($self->storage);
117
    $self->{_file_handle}->binmode;
98
118
    return $self->{_file_handle};
99
    return $storage->fh($self->filepath, 'r');
119
}
100
}
120
101
121
=head3 httpheaders
102
=head3 httpheaders
Lines 141-159 sub httpheaders { Link Here
141
    }
122
    }
142
}
123
}
143
124
144
=head2 CLASS METHODS
125
=head3 url
145
126
146
=head3 permanent_directory
127
Returns the URL to access the file
147
128
148
Returns root directory for permanent storage
129
    my $url = $uploaded_file->url;
149
130
150
=cut
131
=cut
151
132
152
sub permanent_directory {
133
sub url {
153
    my ( $class ) = @_;
134
    my ($self) = @_;
154
    return C4::Context->config('upload_path');
135
136
    my $storage = Koha::Storage->get_instance($self->storage);
137
138
    return $storage->url($self->hashvalue, $self->filepath);
155
}
139
}
156
140
141
=head3 filepath
142
143
Returns the filepath of a file relative to the storage root path
144
145
    my $filepath = $uploaded_file->filepath;
146
147
=cut
148
149
sub filepath {
150
    my ($self) = @_;
151
152
    my $storage = Koha::Storage->get_instance($self->storage);
153
    my $filepath = $storage->filepath({
154
        hashvalue => $self->hashvalue,
155
        filename => $self->filename,
156
        dir => $self->dir,
157
    });
158
159
    return $filepath;
160
}
161
162
=head2 CLASS METHODS
163
157
=head3 _type
164
=head3 _type
158
165
159
Returns name of corresponding DBIC resultset
166
Returns name of corresponding DBIC resultset
(-)a/Koha/UploadedFiles.pm (-15 / +4 lines)
Lines 22-30 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 base qw(Koha::Objects);
28
29
29
=head1 NAME
30
=head1 NAME
30
31
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 (-70 / +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-76 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
use constant ERR_EXISTS   => 'UPLERR_ALREADY_EXISTS';
62
use constant ERR_EXISTS   => 'UPLERR_ALREADY_EXISTS';
64
use constant ERR_PERMS    => 'UPLERR_CANNOT_WRITE';
63
use constant ERR_PERMS    => 'UPLERR_CANNOT_WRITE';
65
use constant ERR_ROOT     => 'UPLERR_NO_ROOT_DIR';
66
use constant ERR_TEMP     => 'UPLERR_NO_TEMP_DIR';
67
64
68
use Modern::Perl;
65
use Modern::Perl;
69
use CGI; # no utf8 flag, since it may interfere with binary uploads
66
use CGI; # no utf8 flag, since it may interfere with binary uploads
70
use Digest::MD5;
67
use Digest::MD5;
71
use Encode;
68
use Encode;
72
use File::Spec;
73
use IO::File;
74
use Time::HiRes;
69
use Time::HiRes;
75
70
76
use base qw(Class::Accessor);
71
use base qw(Class::Accessor);
Lines 79-84 use C4::Context; Link Here
79
use C4::Koha;
74
use C4::Koha;
80
use Koha::UploadedFile;
75
use Koha::UploadedFile;
81
use Koha::UploadedFiles;
76
use Koha::UploadedFiles;
77
use Koha::Storage;
82
78
83
__PACKAGE__->mk_ro_accessors( qw|| );
79
__PACKAGE__->mk_ro_accessors( qw|| );
84
80
Lines 86-95 __PACKAGE__->mk_ro_accessors( qw|| ); Link Here
86
82
87
=head2 new
83
=head2 new
88
84
89
    Returns new object based on Class::Accessor.
85
Returns new object based on Class::Accessor.
90
    Use tmp or temp flag for temporary storage.
86
91
    Use public flag to mark uploads as available in OPAC.
87
    my $uploader = Koha::Uploader->new(\%params);
92
    The category parameter is only useful for permanent storage.
88
89
C<%params> contains the following keys:
90
91
=over
92
93
=item * C<storage>: Mandatory. Storage's name
94
95
=item * C<dir>: Subdirectory in storage
96
97
=item * C<public>: Whether or not the uploaded files are public (available in OPAC).
98
99
=back
93
100
94
=cut
101
=cut
95
102
Lines 192-265 sub allows_add_by { Link Here
192
sub _init {
199
sub _init {
193
    my ( $self, $params ) = @_;
200
    my ( $self, $params ) = @_;
194
201
195
    $self->{rootdir} = Koha::UploadedFile->permanent_directory;
202
    $self->{storage} = Koha::Storage->get_instance($params->{storage});
196
    $self->{tmpdir} = C4::Context::temporary_directory;
197
198
    $params->{tmp} = $params->{temp} if !exists $params->{tmp};
199
    $self->{temporary} = $params->{tmp}? 1: 0; #default false
200
    if( $params->{tmp} ) {
201
        my $db =  C4::Context->config('database');
202
        $self->{category} = KOHA_UPLOAD;
203
        $self->{category} =~ s/koha/$db/;
204
    } else {
205
        $self->{category} = $params->{category} || KOHA_UPLOAD;
206
    }
207
208
    $self->{files} = {};
203
    $self->{files} = {};
209
    $self->{uid} = C4::Context->userenv->{number} if C4::Context->userenv;
204
    $self->{uid} = C4::Context->userenv->{number} if C4::Context->userenv;
210
    $self->{public} = $params->{public}? 1: undef;
205
    $self->{public} = $params->{public} ? 1 : 0;
206
    $self->{dir} = $params->{dir} // '';
211
}
207
}
212
208
213
sub _fh {
209
sub _fh {
214
    my ( $self, $filename ) = @_;
210
    my ( $self, $filename ) = @_;
215
    if( $self->{files}->{$filename} ) {
211
212
    if ( $self->{files}->{$filename} ) {
216
        return $self->{files}->{$filename}->{fh};
213
        return $self->{files}->{$filename}->{fh};
217
    }
214
    }
218
}
215
}
219
216
220
sub _create_file {
217
sub _create_file {
221
    my ( $self, $filename ) = @_;
218
    my ( $self, $filename ) = @_;
222
    my $fh;
219
223
    if( $self->{files}->{$filename} &&
220
    return if ($self->{files}->{$filename} && $self->{files}->{$filename}->{errcode});
224
            $self->{files}->{$filename}->{errcode} ) {
221
    my $hashval = $self->{files}->{$filename}->{hash};
225
        #skip
222
    my $filepath = $self->{storage}->filepath({
226
    } elsif( !$self->{temporary} && !$self->{rootdir} ) {
223
        hashvalue => $hashval,
227
        $self->{files}->{$filename}->{errcode} = ERR_ROOT; #no rootdir
224
        filename => $filename,
228
    } elsif( $self->{temporary} && !$self->{tmpdir} ) {
225
        dir => $self->{dir},
229
        $self->{files}->{$filename}->{errcode} = ERR_TEMP; #no tempdir
226
    });
227
228
    # if the file exists and it is registered, then set error
229
    # if it exists, but is not in the database, we will overwrite
230
    if ( $self->{storage}->exists($filepath) &&
231
    Koha::UploadedFiles->search({
232
        hashvalue => $hashval,
233
        storage => $self->{storage}->{name},
234
    })->count ) {
235
        $self->{files}->{$filename}->{errcode} = ERR_EXISTS; #already exists
236
        return;
237
    }
238
239
    my $fh = $self->{storage}->fh($filepath, 'w');
240
    if ($fh) {
241
        $self->{files}->{$filename}->{fh} = $fh;
230
    } else {
242
    } else {
231
        my $dir = $self->_dir;
243
        $self->{files}->{$filename}->{errcode} = ERR_PERMS; #not writable
232
        my $hashval = $self->{files}->{$filename}->{hash};
233
        my $fn = $hashval. '_'. $filename;
234
235
        # if the file exists and it is registered, then set error
236
        # if it exists, but is not in the database, we will overwrite
237
        if( -e "$dir/$fn" &&
238
        Koha::UploadedFiles->search({
239
            hashvalue          => $hashval,
240
            uploadcategorycode => $self->{category},
241
        })->count ) {
242
            $self->{files}->{$filename}->{errcode} = ERR_EXISTS;
243
            return;
244
        }
245
246
        $fh = IO::File->new( "$dir/$fn", "w");
247
        if( $fh ) {
248
            $fh->binmode;
249
            $self->{files}->{$filename}->{fh}= $fh;
250
        } else {
251
            $self->{files}->{$filename}->{errcode} = ERR_PERMS;
252
        }
253
    }
244
    }
254
    return $fh;
255
}
256
245
257
sub _dir {
246
    return $fh;
258
    my ( $self ) = @_;
259
    my $dir = $self->{temporary}? $self->{tmpdir}: $self->{rootdir};
260
    $dir.= '/'. $self->{category};
261
    mkdir $dir if !-d $dir;
262
    return $dir;
263
}
247
}
264
248
265
sub _hook {
249
sub _hook {
Lines 284-297 sub _done { Link Here
284
sub _register {
268
sub _register {
285
    my ( $self, $filename, $size ) = @_;
269
    my ( $self, $filename, $size ) = @_;
286
    my $rec = Koha::UploadedFile->new({
270
    my $rec = Koha::UploadedFile->new({
271
        storage   => $self->{storage}->{name},
287
        hashvalue => $self->{files}->{$filename}->{hash},
272
        hashvalue => $self->{files}->{$filename}->{hash},
288
        filename  => $filename,
273
        filename  => $filename,
289
        dir       => $self->{category},
274
        dir       => $self->{dir},
290
        filesize  => $size,
275
        filesize  => $size,
291
        owner     => $self->{uid},
276
        owner     => $self->{uid},
292
        uploadcategorycode => $self->{category},
293
        public    => $self->{public},
277
        public    => $self->{public},
294
        permanent => $self->{temporary}? 0: 1,
278
        permanent => $self->{storage}->{temporary} ? 0 : 1,
295
    })->store;
279
    })->store;
296
    $self->{files}->{$filename}->{id} = $rec->id if $rec;
280
    $self->{files}->{$filename}->{id} = $rec->id if $rec;
297
}
281
}
Lines 301-311 sub _compute { Link Here
301
# For temporary files, the id is made unique with time
285
# For temporary files, the id is made unique with time
302
    my ( $self, $name, $block ) = @_;
286
    my ( $self, $name, $block ) = @_;
303
    if( !$self->{files}->{$name}->{hash} ) {
287
    if( !$self->{files}->{$name}->{hash} ) {
304
        my $str = $name. ( $self->{uid} // '0' ).
288
        my $str = $name . ( $self->{uid} // '0' ) .
305
            ( $self->{temporary}? Time::HiRes::time(): '' ).
289
            ( $self->{storage}->{temporary} ? Time::HiRes::time() : '' ) .
306
            $self->{category}. substr( $block, 0, BYTES_DIGEST );
290
            $self->{storage}->{name} . $self->{dir} .
291
            substr( $block, 0, BYTES_DIGEST );
307
        # since Digest cannot handle wide chars, we need to encode here
292
        # since Digest cannot handle wide chars, we need to encode here
308
        # there could be a wide char in the filename or the category
293
        # there could be a wide char in the filename
309
        my $h = Digest::MD5::md5_hex( Encode::encode_utf8( $str ) );
294
        my $h = Digest::MD5::md5_hex( Encode::encode_utf8( $str ) );
310
        $self->{files}->{$name}->{hash} = $h;
295
        $self->{files}->{$name}->{hash} = $h;
311
    }
296
    }
(-)a/cataloguing/value_builder/upload.pl (+3 lines)
Lines 42-47 my $builder = sub { Link Here
42
            if( str && str.match(/id=([0-9a-f]+)/) ) {
42
            if( str && str.match(/id=([0-9a-f]+)/) ) {
43
                term = RegExp.\$1;
43
                term = RegExp.\$1;
44
                myurl = '../tools/upload.pl?op=search&index='+index+'&term='+term+'&plugin=1';
44
                myurl = '../tools/upload.pl?op=search&index='+index+'&term='+term+'&plugin=1';
45
            } else if (str && str.match(/\\/([^\\/]*)\$/)) {
46
                term = RegExp.\$1;
47
                myurl = '../tools/upload.pl?op=search&index='+index+'&term='+term+'&plugin=1';
45
            } else {
48
            } else {
46
                myurl = '../tools/upload.pl?op=new&index='+index+'&plugin=1';
49
                myurl = '../tools/upload.pl?op=new&index='+index+'&plugin=1';
47
            }
50
            }
(-)a/etc/koha-conf.xml (-2 / +9 lines)
Lines 79-86 Link Here
79
 <authorityservershadow>1</authorityservershadow>
79
 <authorityservershadow>1</authorityservershadow>
80
 <pluginsdir>__PLUGINS_DIR__</pluginsdir> <!-- This entry can be repeated to use multiple directories -->
80
 <pluginsdir>__PLUGINS_DIR__</pluginsdir> <!-- This entry can be repeated to use multiple directories -->
81
 <enable_plugins>0</enable_plugins>
81
 <enable_plugins>0</enable_plugins>
82
 <upload_path></upload_path>
82
 <storage>
83
 <tmp_path></tmp_path>
83
    <name>DEFAULT</name>
84
    <adapter>directory</adapter>
85
    <adapter_params>
86
        <!-- Set storage path to enable the default permanent storage -->
87
        <path></path>
88
    </adapter_params>
89
    <hash_filename>1</hash_filename>
90
 </storage>
84
 <intranetdir>__INTRANET_CGI_DIR__</intranetdir>
91
 <intranetdir>__INTRANET_CGI_DIR__</intranetdir>
85
 <opacdir>__OPAC_CGI_DIR__/opac</opacdir>
92
 <opacdir>__OPAC_CGI_DIR__/opac</opacdir>
86
 <opachtdocs>__OPAC_TMPL_DIR__</opachtdocs>
93
 <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/installer/data/mysql/kohastructure.sql (-1 / +1 lines)
Lines 5132-5143 DROP TABLE IF EXISTS `uploaded_files`; Link Here
5132
/*!40101 SET character_set_client = utf8 */;
5132
/*!40101 SET character_set_client = utf8 */;
5133
CREATE TABLE `uploaded_files` (
5133
CREATE TABLE `uploaded_files` (
5134
  `id` int(11) NOT NULL AUTO_INCREMENT,
5134
  `id` int(11) NOT NULL AUTO_INCREMENT,
5135
  `storage` varchar(255) NOT NULL,
5135
  `hashvalue` char(40) COLLATE utf8mb4_unicode_ci NOT NULL,
5136
  `hashvalue` char(40) COLLATE utf8mb4_unicode_ci NOT NULL,
5136
  `filename` mediumtext COLLATE utf8mb4_unicode_ci NOT NULL,
5137
  `filename` mediumtext COLLATE utf8mb4_unicode_ci NOT NULL,
5137
  `dir` mediumtext COLLATE utf8mb4_unicode_ci NOT NULL,
5138
  `dir` mediumtext COLLATE utf8mb4_unicode_ci NOT NULL,
5138
  `filesize` int(11) DEFAULT NULL,
5139
  `filesize` int(11) DEFAULT NULL,
5139
  `dtcreated` timestamp NOT NULL DEFAULT current_timestamp() ON UPDATE current_timestamp(),
5140
  `dtcreated` timestamp NOT NULL DEFAULT current_timestamp() ON UPDATE current_timestamp(),
5140
  `uploadcategorycode` text COLLATE utf8mb4_unicode_ci DEFAULT NULL,
5141
  `owner` int(11) DEFAULT NULL,
5141
  `owner` int(11) DEFAULT NULL,
5142
  `public` tinyint(4) DEFAULT NULL,
5142
  `public` tinyint(4) DEFAULT NULL,
5143
  `permanent` tinyint(4) DEFAULT NULL,
5143
  `permanent` tinyint(4) DEFAULT NULL,
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/offline_circ/process_koc.tt (-1 / +1 lines)
Lines 123-129 Link Here
123
            $("#fileuploadstatus").show();
123
            $("#fileuploadstatus").show();
124
            $("form#processfile #uploadedfileid").val('');
124
            $("form#processfile #uploadedfileid").val('');
125
            $("form#enqueuefile #uploadedfileid").val('');
125
            $("form#enqueuefile #uploadedfileid").val('');
126
            xhr= AjaxUpload( $('#fileToUpload'), $('#fileuploadprogress'), 'temp=1', cbUpload );
126
            xhr= AjaxUpload( $('#fileToUpload'), $('#fileuploadprogress'), 'storage=TMP', cbUpload );
127
        }
127
        }
128
128
129
        function cbUpload( status, fileid, errors ) {
129
        function cbUpload( status, fileid, errors ) {
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/stage-marc-import.tt (-1 / +1 lines)
Lines 434-440 Link Here
434
            $('#profile_fieldset').hide();
434
            $('#profile_fieldset').hide();
435
            $("#fileuploadstatus").show();
435
            $("#fileuploadstatus").show();
436
            $("#uploadedfileid").val('');
436
            $("#uploadedfileid").val('');
437
            xhr= AjaxUpload( $('#fileToUpload'), $('#fileuploadprogress'), 'temp=1', cbUpload );
437
            xhr= AjaxUpload( $('#fileToUpload'), $('#fileuploadprogress'), 'storage=TMP', cbUpload );
438
            $("#fileuploadcancel").show();
438
            $("#fileuploadcancel").show();
439
        }
439
        }
440
        function CancelUpload() {
440
        function CancelUpload() {
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/upload-images.tt (-1 / +1 lines)
Lines 213-219 Link Here
213
            $('#uploadform button.submit').prop('disabled',true);
213
            $('#uploadform button.submit').prop('disabled',true);
214
            $("#fileuploadstatus").show();
214
            $("#fileuploadstatus").show();
215
            $("#uploadedfileid").val('');
215
            $("#uploadedfileid").val('');
216
            xhr= AjaxUpload( $('#fileToUpload'), $('#fileuploadprogress'), 'temp=1', cbUpload );
216
            xhr= AjaxUpload( $('#fileToUpload'), $('#fileuploadprogress'), 'storage=TMP', cbUpload );
217
        }
217
        }
218
        function cbUpload( status, fileid, errors ) {
218
        function cbUpload( status, fileid, errors ) {
219
            if( status=='done' ) {
219
            if( status=='done' ) {
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/upload.tt (-49 / +68 lines)
Lines 1-7 Link Here
1
[% USE raw %]
1
[% USE raw %]
2
[% USE To %]
2
[% USE Asset %]
3
[% USE Asset %]
3
[% USE Koha %]
4
[% USE Koha %]
4
[% USE TablesSettings %]
5
[% USE TablesSettings %]
6
[% USE JSON.Escape %]
5
[% SET footerjs = 1 %]
7
[% SET footerjs = 1 %]
6
[% INCLUDE 'doc-head-open.inc' %]
8
[% INCLUDE 'doc-head-open.inc' %]
7
[% IF plugin %]
9
[% IF plugin %]
Lines 11-16 Link Here
11
[% END %]
13
[% END %]
12
[% INCLUDE 'doc-head-close.inc' %]
14
[% INCLUDE 'doc-head-close.inc' %]
13
15
16
[% BLOCK storage_label %]
17
    [% SWITCH name %]
18
        [% CASE 'TMP' %]Temporary
19
        [% CASE 'DEFAULT' %]Default
20
        [% CASE %][% name | html %]
21
    [% END %]
22
[% END %]
23
14
[% BLOCK plugin_pars %]
24
[% BLOCK plugin_pars %]
15
    [% IF plugin %]
25
    [% IF plugin %]
16
        <input type="hidden" name="plugin" value="1" />
26
        <input type="hidden" name="plugin" value="1" />
Lines 55-89 Link Here
55
            <input type="file" id="fileToUpload" name="fileToUpload" multiple/>
65
            <input type="file" id="fileToUpload" name="fileToUpload" multiple/>
56
        </div>
66
        </div>
57
        </li>
67
        </li>
58
        [% IF uploadcategories %]
68
        <li>
59
            <li>
69
            <label for="storage">Storage: </label>
60
                <label for="uploadcategory">Category: </label>
70
            <select id="storage" name="storage">
61
                <select id="uploadcategory" name="uploadcategory">
71
                [% FOREACH storage IN storages %]
62
                [% IF !plugin %]
72
                    [% UNLESS plugin && storage.temporary %]
63
                    <option value=""></option>
73
                        <option value="[% storage.name | html %]">[% PROCESS storage_label name=storage.name %]</option>
64
                [% END %]
65
                [% FOREACH cat IN uploadcategories %]
66
                    <option value="[% cat.code | html %]">[% cat.name | html %]</option>
67
                [% END %]
68
                </select>
69
            </li>
70
        [% END %]
71
        [% IF !plugin %]
72
            <li>
73
            [% IF uploadcategories %]
74
                <div class="hint">Note: For temporary uploads do not select a category.</div>
75
            [% ELSE %]
76
                <div class="hint">
77
                    Note: No upload categories are defined.
78
                    [% IF ( CAN_user_parameters_manage_auth_values ) -%]
79
                        Add values to the <a href="/cgi-bin/koha/admin/authorised_values.pl?searchfield=UPLOAD">UPLOAD authorized value category</a> otherwise all uploads will be marked as temporary.
80
                    [% ELSE -%]
81
                        An administrator must add values to the UPLOAD authorized value category otherwise all uploads will be marked as temporary.
82
                    [% END %]
74
                    [% END %]
83
                </div>
75
                [% END %]
84
            [% END %]
76
            </select>
85
            </li>
77
        </li>
86
        [% END %]
78
        <li>
79
            <label for="dir">Directory: </label>
80
            <select id="dir" name="dir">
81
            </select>
82
        </li>
87
        <li>
83
        <li>
88
            [% IF plugin %]
84
            [% IF plugin %]
89
                <input type="hidden" id="public" name="public" value="1"/>
85
                <input type="hidden" id="public" name="public" value="1"/>
Lines 196-204 Link Here
196
        <th>Filename</th>
192
        <th>Filename</th>
197
        <th>Size</th>
193
        <th>Size</th>
198
        <th>Hashvalue</th>
194
        <th>Hashvalue</th>
199
        <th>Category</th>
195
        <th>Storage</th>
200
        [% IF !plugin %]<th>Public</th>[% END %]
196
        <th>Directory</th>
201
        [% IF !plugin %]<th>Temporary</th>[% END %]
197
        [% IF !plugin %]
198
            <th>Public</th>
199
            <th>Temporary</th>
200
        [% END %]
202
        <th class="NoSort noExport">Actions</th>
201
        <th class="NoSort noExport">Actions</th>
203
    </tr>
202
    </tr>
204
    </thead>
203
    </thead>
Lines 208-221 Link Here
208
        <td>[% record.filename | html %]</td>
207
        <td>[% record.filename | html %]</td>
209
        <td>[% record.filesize | html %]</td>
208
        <td>[% record.filesize | html %]</td>
210
        <td>[% record.hashvalue | html %]</td>
209
        <td>[% record.hashvalue | html %]</td>
211
        <td>[% record.uploadcategorycode | html %]</td>
210
        <td>[% PROCESS storage_label name=record.storage %]</td>
211
        <td>[% record.dir | html %]</td>
212
        [% IF !plugin %]
212
        [% IF !plugin %]
213
            <td>[% IF record.public %]Yes[% ELSE %]No[% END %]</td>
213
            <td>[% IF record.public %]Yes[% ELSE %]No[% END %]</td>
214
            <td>[% IF record.permanent %]No[% ELSE %]Yes[% END %]</td>
214
            <td>[% IF record.permanent %]No[% ELSE %]Yes[% END %]</td>
215
        [% END %]
215
        [% END %]
216
        <td class="actions">
216
        <td class="actions">
217
            [% IF plugin %]
217
            [% IF plugin %]
218
                <button class="btn btn-default btn-xs choose_entry" data-record-hashvalue="[% record.hashvalue | html %]"><i class="fa fa-plus"></i> Choose</button>
218
                <button class="btn btn-default btn-xs choose_entry" data-record-url="[% record.url | html %]"><i class="fa fa-plus"></i> Choose</button>
219
            [% END %]
219
            [% END %]
220
            <button class="btn btn-default btn-xs download_entry" data-record-id="[% record.id | html %]"><i class="fa fa-download"></i> Download</button>
220
            <button class="btn btn-default btn-xs download_entry" data-record-id="[% record.id | html %]"><i class="fa fa-download"></i> Download</button>
221
            [% IF record.owner == owner || CAN_user_tools_upload_manage %]
221
            [% IF record.owner == owner || CAN_user_tools_upload_manage %]
Lines 312-328 Link Here
312
            $("#searchfile").hide();
312
            $("#searchfile").hide();
313
            $("#lastbreadcrumb").text( _("Add a new upload") );
313
            $("#lastbreadcrumb").text( _("Add a new upload") );
314
314
315
            var cat, xtra='';
315
            var xtra = 'storage=' + $('#storage').val();
316
            if( $("#uploadcategory").val() )
316
            xtra = xtra + '&dir=' + $('#dir').val();
317
                cat = encodeURIComponent( $("#uploadcategory").val() );
318
            if( cat ) xtra= 'category=' + cat + '&';
319
            [% IF plugin %]
317
            [% IF plugin %]
320
                xtra = xtra + 'public=1&temp=0';
318
                xtra = xtra + '&public=1';
321
            [% ELSE %]
319
            [% ELSE %]
322
                if( !cat ) xtra = 'temp=1&';
320
                if ( $('#public').prop('checked') ) {
323
                if( $('#public').prop('checked') ) xtra = xtra + 'public=1';
321
                    xtra = xtra + '&public=1';
322
                }
324
            [% END %]
323
            [% END %]
325
            xhr= AjaxUpload( $('#fileToUpload'), $('#fileuploadprogress'), xtra, cbUpload );
324
            xhr = AjaxUpload( $('#fileToUpload'), $('#fileuploadprogress'), xtra, cbUpload );
326
        }
325
        }
327
        function CancelUpload() {
326
        function CancelUpload() {
328
            if( xhr ) xhr.abort();
327
            if( xhr ) xhr.abort();
Lines 365-371 Link Here
365
            var rv;
364
            var rv;
366
            switch(code) {
365
            switch(code) {
367
                case 'UPLERR_ALREADY_EXISTS':
366
                case 'UPLERR_ALREADY_EXISTS':
368
                    rv = _("This file already exists (in this category).");
367
                    rv = _("This file already exists (in this storage).");
369
                    break;
368
                    break;
370
                case 'UPLERR_CANNOT_WRITE':
369
                case 'UPLERR_CANNOT_WRITE':
371
                    rv = _("File could not be created. Check permissions.");
370
                    rv = _("File could not be created. Check permissions.");
Lines 414-425 Link Here
414
                $(window.opener.document).find('#[% index | html %]').val( '' );
413
                $(window.opener.document).find('#[% index | html %]').val( '' );
415
            [% END %]
414
            [% END %]
416
        }
415
        }
417
        function Choose(hashval) {
416
        function Choose(url) {
418
            var res = '[% Koha.Preference('OPACBaseURL') | html %]';
419
            res = res.replace( /\/$/, '');
420
            res = res + '/cgi-bin/koha/opac-retrieve-file.pl?id=' + hashval;
421
            [% IF index %]
417
            [% IF index %]
422
                $(window.opener.document).find('#[% index | html %]').val( res );
418
                $(window.opener.document).find('#[% index | html %]').val( url );
423
            [% END %]
419
            [% END %]
424
            window.close();
420
            window.close();
425
        }
421
        }
Lines 445-452 Link Here
445
            });
441
            });
446
            $(".choose_entry").on("click",function(e){
442
            $(".choose_entry").on("click",function(e){
447
                e.preventDefault();
443
                e.preventDefault();
448
                var record_hashvalue = $(this).data("record-hashvalue");
444
                var record_url = $(this).data("record-url");
449
                Choose( record_hashvalue );
445
                Choose( record_url );
450
            });
446
            });
451
            $(".download_entry").on("click",function(e){
447
            $(".download_entry").on("click",function(e){
452
                e.preventDefault();
448
                e.preventDefault();
Lines 464-469 Link Here
464
            });
460
            });
465
        });
461
        });
466
    </script>
462
    </script>
463
    <script>
464
        [% FOREACH storage IN storages %]
465
            [% name = storage.name %]
466
            [% storage_directories.$name = storage.directories %]
467
        [% END %]
468
469
        $(document).ready(function () {
470
            let storage_directories = [% To.json(storage_directories) | $raw %];
471
            $('#storage').on('change', function () {
472
                $('#dir').empty();
473
                $('#dir').append($('<option>').val('').html(_("(root)")));
474
                let name = $(this).val()
475
                if (name in storage_directories) {
476
                    storage_directories[name].forEach(function (dir) {
477
                        let option = $('<option>')
478
                            .val(dir)
479
                            .html(dir);
480
                        $('#dir').append(option);
481
                    })
482
                }
483
            }).change();
484
        });
485
    </script>
467
[% END %]
486
[% END %]
468
487
469
[% INCLUDE 'intranet-bottom.inc' %]
488
[% 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 (+182 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, see <http://www.gnu.org/licenses>.
16
17
use Modern::Perl;
18
19
use File::Path qw(remove_tree make_path);
20
use File::Spec;
21
use File::Temp qw(tempdir);
22
use Test::More tests => 5;
23
use Test::MockModule;
24
25
use C4::Context;
26
27
BEGIN { use_ok('Koha::Storage') }
28
29
my $storage_config = [
30
    {
31
        name => 'DEFAULT',
32
        adapter => 'directory',
33
        adapter_params => {
34
            path => tempdir('koha-storage-DEFAULT-XXXXXX', TMPDIR => 1, CLEANUP => 1),
35
        },
36
        hash_filename => 1,
37
    },
38
    {
39
        name => 'external',
40
        adapter => 'directory',
41
        adapter_params => {
42
            path => tempdir('koha-storage-external-XXXXXX', TMPDIR => 1, CLEANUP => 1),
43
        },
44
        baseurl => 'https://external.example.com/',
45
    },
46
];
47
48
my $c4_context = Test::MockModule->new('C4::Context');
49
$c4_context->mock('config', sub {
50
    my ($class, $name) = @_;
51
52
    if ($name eq 'storage') {
53
        return $storage_config;
54
    }
55
56
    return C4::Context::_common_config($name, 'config')
57
});
58
59
my $config = Koha::Storage->config;
60
61
my $expected = [
62
    {
63
        name => 'TMP',
64
        adapter => 'directory',
65
        adapter_params => {
66
            path => File::Spec->catfile(File::Spec->tmpdir, C4::Context->config('database') . '_upload'),
67
        },
68
        temporary => 1,
69
        hash_filename => 1,
70
    },
71
    @$storage_config,
72
];
73
74
is_deeply($config, $expected, 'Koha::Storage->config return value is as expected');
75
76
subtest 'TMP' => sub {
77
    plan tests => 8;
78
79
    # Clean temporary storage
80
    my $tmpdir = $config->[0]->{adapter_params}->{path};
81
    if (-e $tmpdir) {
82
        remove_tree($tmpdir);
83
    }
84
85
    my $tmp_storage = Koha::Storage->get_instance('TMP');
86
    isa_ok($tmp_storage, 'Koha::Storage', 'Koha::Storage->get_instance return value');
87
    is($tmp_storage->{name}, 'TMP', 'Koha::Storage->get_instance returns the correct instance');
88
89
    my $filepath = $tmp_storage->filepath({
90
        dir => 'one/two',
91
        hashvalue => 'abcdef',
92
        filename => 'foo.bar',
93
    });
94
    is($filepath, 'one/two/abcdef_foo.bar', 'filepath is correct');
95
96
    ok(!$tmp_storage->exists($filepath), "$filepath doesn't exist yet");
97
98
    my $fh = $tmp_storage->fh($filepath, 'w');
99
    print $fh 'foo.bar content';
100
    close $fh;
101
102
    ok($tmp_storage->exists($filepath), "$filepath now exists");
103
104
    $fh = $tmp_storage->fh($filepath, 'r');
105
    my $content = <$fh>;
106
    is($content, 'foo.bar content', "$filepath content is as expected");
107
108
    my $directories = $tmp_storage->directories;
109
    is_deeply($directories, ['one', 'one/two'], 'directories() return value is as expected');
110
111
    my $url = $tmp_storage->url('abcdef', $filepath);
112
    my $expected_url = C4::Context->preference('OPACBaseURL') . '/cgi-bin/koha/opac-retrieve-file.pl?id=abcdef';
113
    is($url, $expected_url, 'url() return value is as expected');
114
};
115
116
subtest 'DEFAULT' => sub {
117
    plan tests => 8;
118
119
    my $storage = Koha::Storage->get_instance('DEFAULT');
120
    isa_ok($storage, 'Koha::Storage', 'Koha::Storage->get_instance return value');
121
    is($storage->{name}, 'DEFAULT', 'Koha::Storage->get_instance returns the correct instance');
122
123
    my $filepath = $storage->filepath({
124
        dir => 'one/two',
125
        hashvalue => 'abcdef',
126
        filename => 'foo.bar',
127
    });
128
    is($filepath, 'one/two/abcdef_foo.bar', 'filepath is correct');
129
130
    ok(!$storage->exists($filepath), "$filepath doesn't exist yet");
131
132
    my $fh = $storage->fh($filepath, 'w');
133
    print $fh 'foo.bar content';
134
    close $fh;
135
136
    ok($storage->exists($filepath), "$filepath now exists");
137
138
    $fh = $storage->fh($filepath, 'r');
139
    my $content = <$fh>;
140
    is($content, 'foo.bar content', "$filepath content is as expected");
141
142
    my $directories = $storage->directories;
143
    is_deeply($directories, ['one', 'one/two'], 'directories() return value is as expected');
144
145
    my $url = $storage->url('abcdef', $filepath);
146
    my $expected_url = C4::Context->preference('OPACBaseURL') . '/cgi-bin/koha/opac-retrieve-file.pl?id=abcdef';
147
    is($url, $expected_url, 'url() return value is as expected');
148
};
149
150
subtest 'external' => sub {
151
    plan tests => 8;
152
153
    my $storage = Koha::Storage->get_instance('external');
154
    isa_ok($storage, 'Koha::Storage', 'Koha::Storage->get_instance return value');
155
    is($storage->{name}, 'external', 'Koha::Storage->get_instance returns the correct instance');
156
157
    my $filepath = $storage->filepath({
158
        dir => 'one/two',
159
        hashvalue => 'abcdef',
160
        filename => 'foo.bar',
161
    });
162
    is($filepath, 'one/two/foo.bar', 'filepath is correct');
163
164
    ok(!$storage->exists($filepath), "$filepath doesn't exist yet");
165
166
    my $fh = $storage->fh($filepath, 'w');
167
    print $fh 'foo.bar content';
168
    close $fh;
169
170
    ok($storage->exists($filepath), "$filepath now exists");
171
172
    $fh = $storage->fh($filepath, 'r');
173
    my $content = <$fh>;
174
    is($content, 'foo.bar content', "$filepath content is as expected");
175
176
    my $directories = $storage->directories;
177
    is_deeply($directories, ['one', 'one/two'], 'directories() return value is as expected');
178
179
    my $url = $storage->url('abcdef', $filepath);
180
    my $expected_url = 'https://external.example.com/one/two/foo.bar';
181
    is($url, $expected_url, 'url() return value is as expected');
182
};
(-)a/t/db_dependent/ImportBatch.t (-1 / +6 lines)
Lines 183-189 my $batch3_results = $dbh->do('SELECT * FROM import_batches WHERE import_batch_i Link Here
183
is( $batch3_results, "0E0", "Batch 3 has been deleted");
183
is( $batch3_results, "0E0", "Batch 3 has been deleted");
184
184
185
subtest "RecordsFromMarcPlugin" => sub {
185
subtest "RecordsFromMarcPlugin" => sub {
186
    plan tests => 5;
186
    plan tests => 6;
187
187
188
    # Create a test file
188
    # Create a test file
189
    my ( $fh, $name ) = tempfile();
189
    my ( $fh, $name ) = tempfile();
Lines 211-216 subtest "RecordsFromMarcPlugin" => sub { Link Here
211
        'Checked one field in first record' );
211
        'Checked one field in first record' );
212
    is( $records->[1]->subfield('100', 'a'), 'Another',
212
    is( $records->[1]->subfield('100', 'a'), 'Another',
213
        'Checked one field in second record' );
213
        'Checked one field in second record' );
214
215
    open my $fh2, '<', $name;
216
    $records = C4::ImportBatch::RecordsFromMarcPlugin( $fh2, ref $plugin, 'UTF-8' );
217
    close $fh2;
218
    is( @$records, 2, 'Can take a filehandle as parameter' );
214
};
219
};
215
220
216
$schema->storage->txn_rollback;
221
$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 => 13;
5
use Test::More tests => 12;
6
use Test::Warn;
6
use Test::Warn;
7
use Try::Tiny;
7
use Try::Tiny;
8
8
Lines 24-57 our $builder = t::lib::TestBuilder->new; Link Here
24
our $current_upload = 0;
24
our $current_upload = 0;
25
our $uploads = [
25
our $uploads = [
26
    [
26
    [
27
        { name => 'file1', cat => 'A', size => 6000 },
27
        { name => 'file1', storage => 'DEFAULT', dir => 'A', size => 6000 },
28
        { name => 'file2', cat => 'A', size => 8000 },
28
        { name => 'file2', storage => 'DEFAULT', dir => 'A', size => 8000 },
29
    ],
29
    ],
30
    [
30
    [
31
        { name => 'file3', cat => 'B', size => 1000 },
31
        { name => 'file3', storage => 'DEFAULT', dir => 'B', size => 1000 },
32
    ],
32
    ],
33
    [
33
    [
34
        { name => 'file4', cat => undef, size => 5000 }, # temporary
34
        { name => 'file4', storage => 'TMP', dir => undef, size => 5000 },
35
    ],
35
    ],
36
    [
36
    [
37
        { name => 'file2', cat => 'A', size => 8000 },
37
        { name => 'file2', storage => 'DEFAULT', dir => 'A', size => 8000 },
38
        # uploading a duplicate in cat A should fail
38
        # uploading a duplicate in dir A should fail
39
    ],
39
    ],
40
    [
40
    [
41
        { name => 'file4', cat => undef, size => 5000 }, # temp duplicate
41
        { name => 'file4', storage => 'TMP', dir => undef, size => 5000 }, # temp duplicate
42
    ],
42
    ],
43
    [
43
    [
44
        { name => 'file5', cat => undef, size => 7000 },
44
        { name => 'file5', storage => 'DEFAULT', dir => undef, size => 7000 },
45
    ],
45
    ],
46
    [
46
    [
47
        { name => 'file6', cat => undef, size => 6500 },
47
        { name => 'file6', storage => 'TMP', dir => undef, size => 6500 },
48
        { name => 'file7', cat => undef, size => 6501 },
48
        { name => 'file7', storage => 'TMP', dir => undef, size => 6501 },
49
    ],
49
    ],
50
];
50
];
51
51
52
# Redirect upload dir structure and mock C4::Context and CGI
52
# Redirect upload dir structure and mock C4::Context and CGI
53
my $tempdir = tempdir( CLEANUP => 1 );
53
my $tempdir = tempdir( CLEANUP => 1 );
54
t::lib::Mocks::mock_config('upload_path', $tempdir);
54
my $storage_config = [
55
    {
56
        name => 'DEFAULT',
57
        adapter => 'directory',
58
        adapter_params => {
59
            path => $tempdir,
60
        },
61
        hash_filename => 1,
62
    },
63
];
64
t::lib::Mocks::mock_config('storage', $storage_config);
55
my $specmod = Test::MockModule->new( 'C4::Context' );
65
my $specmod = Test::MockModule->new( 'C4::Context' );
56
$specmod->mock( 'temporary_directory' => sub { return $tempdir; } );
66
$specmod->mock( 'temporary_directory' => sub { return $tempdir; } );
57
my $cgimod = Test::MockModule->new( 'CGI' );
67
my $cgimod = Test::MockModule->new( 'CGI' );
Lines 69-89 subtest 'Make a fresh start' => sub { Link Here
69
    is( Koha::UploadedFiles->count, 0, 'No records left' );
79
    is( Koha::UploadedFiles->count, 0, 'No records left' );
70
};
80
};
71
81
72
subtest 'permanent_directory and temporary_directory' => sub {
73
    plan tests => 2;
74
75
    # Check mocked directories
76
    is( Koha::UploadedFile->permanent_directory, $tempdir,
77
        'Check permanent directory' );
78
    is( C4::Context::temporary_directory, $tempdir,
79
        'Check temporary directory' );
80
};
81
82
subtest 'Add two uploads in category A' => sub {
82
subtest 'Add two uploads in category A' => sub {
83
    plan tests => 9;
83
    plan tests => 9;
84
84
85
    my $upl = Koha::Uploader->new({
85
    my $upl = Koha::Uploader->new({
86
        category => $uploads->[$current_upload]->[0]->{cat},
86
        storage => $uploads->[$current_upload]->[0]->{storage},
87
        dir => $uploads->[$current_upload]->[0]->{dir},
87
    });
88
    });
88
    my $cgi= $upl->cgi;
89
    my $cgi= $upl->cgi;
89
    my $res= $upl->result;
90
    my $res= $upl->result;
Lines 96-121 subtest 'Add two uploads in category A' => sub { Link Here
96
    }, { order_by => { -asc => 'filename' }});
97
    }, { order_by => { -asc => 'filename' }});
97
    my $rec = $rs->next;
98
    my $rec = $rs->next;
98
    is( $rec->filename, 'file1', 'Check file name' );
99
    is( $rec->filename, 'file1', 'Check file name' );
99
    is( $rec->uploadcategorycode, 'A', 'Check category A' );
100
    is( $rec->dir, 'A', 'Check dir A' );
100
    is( $rec->filesize, 6000, 'Check size of file1' );
101
    is( $rec->filesize, 6000, 'Check size of file1' );
101
    $rec = $rs->next;
102
    $rec = $rs->next;
102
    is( $rec->filename, 'file2', 'Check file name 2' );
103
    is( $rec->filename, 'file2', 'Check file name 2' );
103
    is( $rec->filesize, 8000, 'Check size of file2' );
104
    is( $rec->filesize, 8000, 'Check size of file2' );
104
    is( $rec->public, undef, 'Check public undefined' );
105
    is( $rec->public, 0, 'Check public 0' );
105
};
106
};
106
107
107
subtest 'Add another upload, check file_handle' => sub {
108
subtest 'Add another upload, check file_handle' => sub {
108
    plan tests => 5;
109
    plan tests => 5;
109
110
110
    my $upl = Koha::Uploader->new({
111
    my $upl = Koha::Uploader->new({
111
        category => $uploads->[$current_upload]->[0]->{cat},
112
        storage => $uploads->[$current_upload]->[0]->{storage},
113
        dir => $uploads->[$current_upload]->[0]->{dir},
112
        public => 1,
114
        public => 1,
113
    });
115
    });
114
    my $cgi= $upl->cgi;
116
    my $cgi= $upl->cgi;
115
    is( $upl->count, 1, 'Upload 2 includes one file' );
117
    is( $upl->count, 1, 'Upload 2 includes one file' );
116
    my $res= $upl->result;
118
    my $res= $upl->result;
117
    my $rec = Koha::UploadedFiles->find( $res );
119
    my $rec = Koha::UploadedFiles->find( $res );
118
    is( $rec->uploadcategorycode, 'B', 'Check category B' );
120
    is( $rec->dir, 'B', 'Check dir B' );
119
    is( $rec->public, 1, 'Check public == 1' );
121
    is( $rec->public, 1, 'Check public == 1' );
120
    my $fh = $rec->file_handle;
122
    my $fh = $rec->file_handle;
121
    is( ref($fh) eq 'IO::File' && $fh->opened, 1, 'Get returns a file handle' );
123
    is( ref($fh) eq 'IO::File' && $fh->opened, 1, 'Get returns a file handle' );
Lines 129-146 subtest 'Add another upload, check file_handle' => sub { Link Here
129
subtest 'Add temporary upload' => sub {
131
subtest 'Add temporary upload' => sub {
130
    plan tests => 2;
132
    plan tests => 2;
131
133
132
    my $upl = Koha::Uploader->new({ tmp => 1 }); #temporary
134
    my $upl = Koha::Uploader->new({
135
        storage => $uploads->[$current_upload]->[0]->{storage},
136
        dir => $uploads->[$current_upload]->[0]->{dir},
137
    });
133
    my $cgi= $upl->cgi;
138
    my $cgi= $upl->cgi;
134
    is( $upl->count, 1, 'Upload 3 includes one temporary file' );
139
    is( $upl->count, 1, 'Upload 3 includes one temporary file' );
135
    my $rec = Koha::UploadedFiles->find( $upl->result );
140
    my $rec = Koha::UploadedFiles->find( $upl->result );
136
    is( $rec->uploadcategorycode =~ /_upload$/, 1, 'Check category temp file' );
141
    is( $rec->dir, '', 'Check dir is empty' );
137
};
142
};
138
143
139
subtest 'Add same file in same category' => sub {
144
subtest 'Add same file in same category' => sub {
140
    plan tests => 3;
145
    plan tests => 3;
141
146
142
    my $upl = Koha::Uploader->new({
147
    my $upl = Koha::Uploader->new({
143
        category => $uploads->[$current_upload]->[0]->{cat},
148
        storage => $uploads->[$current_upload]->[0]->{storage},
149
        dir => $uploads->[$current_upload]->[0]->{dir},
144
    });
150
    });
145
    my $cgi= $upl->cgi;
151
    my $cgi= $upl->cgi;
146
    is( $upl->count, 0, 'Upload 4 failed as expected' );
152
    is( $upl->count, 0, 'Upload 4 failed as expected' );
Lines 153-183 subtest 'Test delete via UploadedFile as well as UploadedFiles' => sub { Link Here
153
    plan tests => 10;
159
    plan tests => 10;
154
160
155
    # add temporary file with same name and contents (file4)
161
    # add temporary file with same name and contents (file4)
156
    my $upl = Koha::Uploader->new({ tmp => 1 });
162
    my $upl = Koha::Uploader->new({
163
        storage => $uploads->[$current_upload]->[0]->{storage},
164
        dir => $uploads->[$current_upload]->[0]->{dir},
165
    });
157
    my $cgi= $upl->cgi;
166
    my $cgi= $upl->cgi;
158
    is( $upl->count, 1, 'Add duplicate temporary file (file4)' );
167
    is( $upl->count, 1, 'Add duplicate temporary file (file4)' );
159
    my $id = $upl->result;
168
    my $id = $upl->result;
160
    my $path = Koha::UploadedFiles->find( $id )->full_path;
169
    my $uploaded_file = Koha::UploadedFiles->find( $id );
170
    my $storage = Koha::Storage->get_instance($uploaded_file->storage);
161
171
162
    # testing delete via UploadedFiles (plural)
172
    # testing delete via UploadedFiles (plural)
163
    my $delete = Koha::UploadedFiles->search({ id => $id })->delete;
173
    my $delete = Koha::UploadedFiles->search({ id => $id })->delete;
164
    isnt( $delete, "0E0", 'Delete successful' );
174
    isnt( $delete, "0E0", 'Delete successful' );
165
    isnt( -e $path, 1, 'File no longer found after delete' );
175
    isnt( $storage->exists($uploaded_file->filepath), 1, 'File no longer found after delete' );
166
    is( Koha::UploadedFiles->find( $id ), undef, 'Record also gone' );
176
    is( Koha::UploadedFiles->find( $id ), undef, 'Record also gone' );
167
177
168
    # testing delete via UploadedFile (singular)
178
    # testing delete via UploadedFile (singular)
169
    # Note that find returns a Koha::Object
179
    # Note that find returns a Koha::Object
170
    $upl = Koha::Uploader->new({ tmp => 1 });
180
    $upl = Koha::Uploader->new({
181
        storage => $uploads->[$current_upload]->[0]->{storage},
182
        dir => $uploads->[$current_upload]->[0]->{dir},
183
    });
171
    $upl->cgi;
184
    $upl->cgi;
172
    my $kohaobj = Koha::UploadedFiles->find( $upl->result );
185
    my $kohaobj = Koha::UploadedFiles->find( $upl->result );
173
    $path = $kohaobj->full_path;
186
    $storage = Koha::Storage->get_instance($kohaobj->storage);
174
    $delete = $kohaobj->delete;
187
    $delete = $kohaobj->delete;
175
    ok( $delete, 'Delete successful' );
188
    ok( $delete, 'Delete successful' );
176
    isnt( -e $path, 1, 'File no longer found after delete' );
189
    isnt($storage->exists($kohaobj->filepath), 1, 'File no longer found after delete' );
177
190
178
    # add another record with TestBuilder, so file does not exist
191
    # add another record with TestBuilder, so file does not exist
179
    # catch warning
192
    # catch warning
180
    my $upload01 = $builder->build({ source => 'UploadedFile' });
193
    my $upload01 = $builder->build({ source => 'UploadedFile', value => {storage => 'TMP'} });
181
    warning_like { $delete = Koha::UploadedFiles->find( $upload01->{id} )->delete; }
194
    warning_like { $delete = Koha::UploadedFiles->find( $upload01->{id} )->delete; }
182
        qr/file was missing/,
195
        qr/file was missing/,
183
        'delete warns when file is missing';
196
        'delete warns when file is missing';
Lines 199-206 subtest 'Test delete_missing' => sub { Link Here
199
    plan tests => 5;
212
    plan tests => 5;
200
213
201
    # If we add files via TestBuilder, they do not exist
214
    # If we add files via TestBuilder, they do not exist
202
    my $upload01 = $builder->build({ source => 'UploadedFile' });
215
    my $upload01 = $builder->build({ source => 'UploadedFile', value => {storage => 'TMP'} });
203
    my $upload02 = $builder->build({ source => 'UploadedFile' });
216
    my $upload02 = $builder->build({ source => 'UploadedFile', value => {storage => 'TMP'} });
204
    # dry run first
217
    # dry run first
205
    my $deleted = Koha::UploadedFiles->delete_missing({ keep_record => 1 });
218
    my $deleted = Koha::UploadedFiles->delete_missing({ keep_record => 1 });
206
    is( $deleted, 2, 'Expect two records with missing files' );
219
    is( $deleted, 2, 'Expect two records with missing files' );
Lines 227-241 subtest 'Call search_term with[out] private flag' => sub { Link Here
227
    })->count, 4, 'Returns now four results' );
240
    })->count, 4, 'Returns now four results' );
228
};
241
};
229
242
230
subtest 'Simple tests for httpheaders and getCategories' => sub {
243
subtest 'Simple tests for httpheaders' => sub {
231
    plan tests => 2;
244
    plan tests => 1;
232
245
233
    my $rec = Koha::UploadedFiles->search_term({ term => 'file' })->next;
246
    my $rec = Koha::UploadedFiles->search_term({ term => 'file' })->next;
234
    my @hdrs = $rec->httpheaders;
247
    my @hdrs = $rec->httpheaders;
235
    is( @hdrs == 4 && $hdrs[1] =~ /application\/octet-stream/, 1, 'Simple test for httpheaders');
248
    is( @hdrs == 4 && $hdrs[1] =~ /application\/octet-stream/, 1, 'Simple test for httpheaders');
236
    $builder->build({ source => 'AuthorisedValue', value => { category => 'UPLOAD', authorised_value => 'HAVE_AT_LEAST_ONE', lib => 'Hi there' } });
249
    $builder->build({ source => 'AuthorisedValue', value => { category => 'UPLOAD', authorised_value => 'HAVE_AT_LEAST_ONE', lib => 'Hi there' } });
237
    my $cat = Koha::UploadedFiles->getCategories;
238
    is( @$cat >= 1, 1, 'getCategories returned at least one category' );
239
};
250
};
240
251
241
subtest 'Testing allows_add_by' => sub {
252
subtest 'Testing allows_add_by' => sub {
Lines 280-286 subtest 'Testing delete_temporary' => sub { Link Here
280
    plan tests => 9;
291
    plan tests => 9;
281
292
282
    # Add two temporary files: result should be 3 + 3
293
    # Add two temporary files: result should be 3 + 3
283
    Koha::Uploader->new({ tmp => 1 })->cgi; # add file6 and file7
294
    Koha::Uploader->new({
295
        storage => $uploads->[$current_upload]->[0]->{storage},
296
        dir => $uploads->[$current_upload]->[0]->{dir},
297
    })->cgi; # add file6 and file7
284
    is( Koha::UploadedFiles->search->count, 6, 'Test starting count' );
298
    is( Koha::UploadedFiles->search->count, 6, 'Test starting count' );
285
    is( Koha::UploadedFiles->search({ permanent => 1 })->count, 3,
299
    is( Koha::UploadedFiles->search({ permanent => 1 })->count, 3,
286
        'Includes 3 permanent' );
300
        'Includes 3 permanent' );
(-)a/tools/stage-marc-import.pl (-4 / +5 lines)
Lines 89-105 if ($completedJobID) { Link Here
89
    $template->param(map { $_ => $results->{$_} } keys %{ $results });
89
    $template->param(map { $_ => $results->{$_} } keys %{ $results });
90
} elsif ($fileID) {
90
} elsif ($fileID) {
91
    my $upload = Koha::UploadedFiles->find( $fileID );
91
    my $upload = Koha::UploadedFiles->find( $fileID );
92
    my $file = $upload->full_path;
92
    my $storage = Koha::Storage->get_instance($upload->storage);
93
    my $fh = $storage->fh($upload->filepath, 'r');
93
    my $filename = $upload->filename;
94
    my $filename = $upload->filename;
94
95
95
    my ( $errors, $marcrecords );
96
    my ( $errors, $marcrecords );
96
    if( $format eq 'MARCXML' ) {
97
    if( $format eq 'MARCXML' ) {
97
        ( $errors, $marcrecords ) = C4::ImportBatch::RecordsFromMARCXMLFile( $file, $encoding);
98
        ( $errors, $marcrecords ) = C4::ImportBatch::RecordsFromMARCXMLFile( $fh, $encoding);
98
    } elsif( $format eq 'ISO2709' ) {
99
    } elsif( $format eq 'ISO2709' ) {
99
        ( $errors, $marcrecords ) = C4::ImportBatch::RecordsFromISO2709File( $file, $record_type, $encoding );
100
        ( $errors, $marcrecords ) = C4::ImportBatch::RecordsFromISO2709File( $fh, $record_type, $encoding );
100
    } else { # plugin based
101
    } else { # plugin based
101
        $errors = [];
102
        $errors = [];
102
        $marcrecords = C4::ImportBatch::RecordsFromMarcPlugin( $file, $format, $encoding );
103
        $marcrecords = C4::ImportBatch::RecordsFromMarcPlugin( $fh, $format, $encoding );
103
    }
104
    }
104
    warn "$filename: " . ( join ',', @$errors ) if @$errors;
105
    warn "$filename: " . ( join ',', @$errors ) if @$errors;
105
        # no need to exit if we have no records (or only errors) here
106
        # no need to exit if we have no records (or only errors) here
(-)a/tools/upload-cover-image.pl (-4 / +8 lines)
Lines 39-44 resized, maintaining aspect ratio. Link Here
39
39
40
use Modern::Perl;
40
use Modern::Perl;
41
41
42
use Archive::Zip qw(:ERROR_CODES);
42
use File::Temp;
43
use File::Temp;
43
use CGI qw ( -utf8 );
44
use CGI qw ( -utf8 );
44
use GD;
45
use GD;
Lines 125-135 if ($fileID) { Link Here
125
        undef $srcimage;
126
        undef $srcimage;
126
    }
127
    }
127
    else {
128
    else {
128
        my $filename = $upload->full_path;
129
        my $storage = Koha::Storage->get_instance($upload->storage);
130
        my $fh = $storage->fh($upload->filepath, 'r');
129
        my $dirname = File::Temp::tempdir( CLEANUP => 1 );
131
        my $dirname = File::Temp::tempdir( CLEANUP => 1 );
130
        qx/unzip $filename -d $dirname/;
132
        my $zip = Archive::Zip->new();
131
        my $exit_code = $?;
133
        $zip->readFromFileHandle($fh);
132
        unless ( $exit_code == 0 ) {
134
        unless (AZ_OK == $zip->extractTree(undef, $dirname)) {
133
            $error = 'UZIPFAIL';
135
            $error = 'UZIPFAIL';
134
        }
136
        }
135
        else {
137
        else {
Lines 169-174 if ($fileID) { Link Here
169
                            $error = 'DELERR';
171
                            $error = 'DELERR';
170
                        }
172
                        }
171
                        else {
173
                        else {
174
                            my $filename;
172
                            ( $biblionumber, $filename ) = split $delim, $line, 2;
175
                            ( $biblionumber, $filename ) = split $delim, $line, 2;
173
                            $biblionumber =~
176
                            $biblionumber =~
174
                              s/[\"\r\n]//g;    # remove offensive characters
177
                              s/[\"\r\n]//g;    # remove offensive characters
Lines 216-221 if ($fileID) { Link Here
216
                }
219
                }
217
            }
220
            }
218
        }
221
        }
222
        close $fh;
219
    }
223
    }
220
224
221
    $template->param(
225
    $template->param(
(-)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 (-5 / +12 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
use constant ERR_READING     => 'UPLERR_FILE_NOT_READ';
30
use constant ERR_READING     => 'UPLERR_FILE_NOT_READ';
Lines 46-56 my ( $template, $loggedinuser, $cookie ) = get_template_and_user( Link Here
46
    }
48
    }
47
);
49
);
48
50
51
my @storages;
52
foreach my $config (@{ Koha::Storage->config }) {
53
    my $storage = Koha::Storage->get_instance($config->{name});
54
    push @storages, $storage if $storage;
55
}
56
49
$template->param(
57
$template->param(
50
    index      => $index,
58
    index      => $index,
51
    owner      => $loggedinuser,
59
    owner      => $loggedinuser,
52
    plugin     => $plugin,
60
    plugin     => $plugin,
53
    uploadcategories => Koha::UploadedFiles->getCategories,
61
    storages   => \@storages,
54
);
62
);
55
63
56
if ( $op eq 'new' ) {
64
if ( $op eq 'new' ) {
Lines 81-95 if ( $op eq 'new' ) { Link Here
81
        my @id = split /,/, $id;
89
        my @id = split /,/, $id;
82
        foreach my $recid (@id) {
90
        foreach my $recid (@id) {
83
            my $rec = Koha::UploadedFiles->find( $recid );
91
            my $rec = Koha::UploadedFiles->find( $recid );
84
            push @$uploads, $rec->unblessed
92
            push @$uploads, $rec
85
                if $rec && ( $rec->public || !$plugin );
93
                if $rec && ( $rec->public || !$plugin );
86
                # Do not show private uploads in the plugin mode (:editor)
94
                # Do not show private uploads in the plugin mode (:editor)
87
        }
95
        }
88
    } else {
96
    } else {
89
        $uploads = Koha::UploadedFiles->search_term({
97
        $uploads = [ Koha::UploadedFiles->search_term({
90
            term => $term,
98
            term => $term,
91
            $plugin? (): ( include_private => 1 ),
99
            $plugin? (): ( include_private => 1 ),
92
        })->unblessed;
100
        }) ];
93
    }
101
    }
94
102
95
    $template->param(
103
    $template->param(
96
- 

Return to bug 19318