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 qw( GetNormalizedISBN );
26
use C4::Koha qw( GetNormalizedISBN );
25
use C4::Biblio qw(
27
use C4::Biblio qw(
Lines 1531-1537 sub SetImportRecordMatches { Link Here
1531
1533
1532
Reads ISO2709 binary porridge from the given file and creates MARC::Record-objects out of it.
1534
Reads ISO2709 binary porridge from the given file and creates MARC::Record-objects out of it.
1533
1535
1534
@PARAM1, String, absolute path to the ISO2709 file.
1536
@PARAM1, String, absolute path to the ISO2709 file or an open filehandle.
1535
@PARAM2, String, see stage_file.pl
1537
@PARAM2, String, see stage_file.pl
1536
@PARAM3, String, should be utf8
1538
@PARAM3, String, should be utf8
1537
1539
Lines 1546-1552 sub RecordsFromISO2709File { Link Here
1546
    my $marc_type = C4::Context->preference('marcflavour');
1548
    my $marc_type = C4::Context->preference('marcflavour');
1547
    $marc_type .= 'AUTH' if ($marc_type eq 'UNIMARC' && $record_type eq 'auth');
1549
    $marc_type .= 'AUTH' if ($marc_type eq 'UNIMARC' && $record_type eq 'auth');
1548
1550
1549
    open my $fh, '<', $input_file or die "$0: cannot open input file $input_file: $!\n";
1551
    my $fh;
1552
    if (openhandle($input_file)) {
1553
        $fh = $input_file;
1554
    } else {
1555
        open $fh, '<', $input_file or die "$0: cannot open input file $input_file: $!\n";
1556
    }
1557
1550
    my @marc_records;
1558
    my @marc_records;
1551
    $/ = "\035";
1559
    $/ = "\035";
1552
    while (<$fh>) {
1560
    while (<$fh>) {
Lines 1562-1567 sub RecordsFromISO2709File { Link Here
1562
        }
1570
        }
1563
    }
1571
    }
1564
    close $fh;
1572
    close $fh;
1573
1565
    return ( \@errors, \@marc_records );
1574
    return ( \@errors, \@marc_records );
1566
}
1575
}
1567
1576
Lines 1571-1577 sub RecordsFromISO2709File { Link Here
1571
1580
1572
Creates MARC::Record-objects out of the given MARCXML-file.
1581
Creates MARC::Record-objects out of the given MARCXML-file.
1573
1582
1574
@PARAM1, String, absolute path to the ISO2709 file.
1583
@PARAM1, String, absolute path to the ISO2709 file or an open filehandle
1575
@PARAM2, String, should be utf8
1584
@PARAM2, String, should be utf8
1576
1585
1577
Returns two array refs.
1586
Returns two array refs.
Lines 1594-1600 sub RecordsFromMARCXMLFile { Link Here
1594
1603
1595
=head2 RecordsFromMarcPlugin
1604
=head2 RecordsFromMarcPlugin
1596
1605
1597
    Converts text of input_file into array of MARC records with to_marc plugin
1606
Converts text of C<$input_file> into array of MARC records with to_marc plugin
1607
1608
C<$input_file> can be either a filename or an open filehandle.
1598
1609
1599
=cut
1610
=cut
1600
1611
Lines 1604-1610 sub RecordsFromMarcPlugin { Link Here
1604
    return \@return if !$input_file || !$plugin_class;
1615
    return \@return if !$input_file || !$plugin_class;
1605
1616
1606
    # Read input file
1617
    # Read input file
1607
    open my $fh, '<', $input_file or die "$0: cannot open input file $input_file: $!\n";
1618
    my $fh;
1619
    if (openhandle($input_file)) {
1620
        $fh = $input_file;
1621
    } else {
1622
        open $fh, '<', $input_file or die "$0: cannot open input file $input_file: $!\n";
1623
    }
1624
1608
    $/ = "\035";
1625
    $/ = "\035";
1609
    while (<$fh>) {
1626
    while (<$fh>) {
1610
        s/^\s+//;
1627
        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 qw( GetAuthorisedValues );
22
use C4::Koha qw( GetAuthorisedValues );
23
use Koha::Database;
23
use Koha::Database;
24
use Koha::DateUtils qw( dt_from_string );
24
use Koha::DateUtils qw( dt_from_string );
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 (-69 / +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-75 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 IO::File;
73
use Time::HiRes;
69
use Time::HiRes;
74
70
75
use base qw(Class::Accessor);
71
use base qw(Class::Accessor);
Lines 78-83 use C4::Context; Link Here
78
use C4::Koha;
74
use C4::Koha;
79
use Koha::UploadedFile;
75
use Koha::UploadedFile;
80
use Koha::UploadedFiles;
76
use Koha::UploadedFiles;
77
use Koha::Storage;
81
78
82
__PACKAGE__->mk_ro_accessors( qw|| );
79
__PACKAGE__->mk_ro_accessors( qw|| );
83
80
Lines 85-94 __PACKAGE__->mk_ro_accessors( qw|| ); Link Here
85
82
86
=head2 new
83
=head2 new
87
84
88
    Returns new object based on Class::Accessor.
85
Returns new object based on Class::Accessor.
89
    Use tmp or temp flag for temporary storage.
86
90
    Use public flag to mark uploads as available in OPAC.
87
    my $uploader = Koha::Uploader->new(\%params);
91
    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
92
100
93
=cut
101
=cut
94
102
Lines 191-264 sub allows_add_by { Link Here
191
sub _init {
199
sub _init {
192
    my ( $self, $params ) = @_;
200
    my ( $self, $params ) = @_;
193
201
194
    $self->{rootdir} = Koha::UploadedFile->permanent_directory;
202
    $self->{storage} = Koha::Storage->get_instance($params->{storage});
195
    $self->{tmpdir} = C4::Context::temporary_directory;
196
197
    $params->{tmp} = $params->{temp} if !exists $params->{tmp};
198
    $self->{temporary} = $params->{tmp}? 1: 0; #default false
199
    if( $params->{tmp} ) {
200
        my $db =  C4::Context->config('database');
201
        $self->{category} = KOHA_UPLOAD;
202
        $self->{category} =~ s/koha/$db/;
203
    } else {
204
        $self->{category} = $params->{category} || KOHA_UPLOAD;
205
    }
206
207
    $self->{files} = {};
203
    $self->{files} = {};
208
    $self->{uid} = C4::Context->userenv->{number} if C4::Context->userenv;
204
    $self->{uid} = C4::Context->userenv->{number} if C4::Context->userenv;
209
    $self->{public} = $params->{public}? 1: undef;
205
    $self->{public} = $params->{public} ? 1 : 0;
206
    $self->{dir} = $params->{dir} // '';
210
}
207
}
211
208
212
sub _fh {
209
sub _fh {
213
    my ( $self, $filename ) = @_;
210
    my ( $self, $filename ) = @_;
214
    if( $self->{files}->{$filename} ) {
211
212
    if ( $self->{files}->{$filename} ) {
215
        return $self->{files}->{$filename}->{fh};
213
        return $self->{files}->{$filename}->{fh};
216
    }
214
    }
217
}
215
}
218
216
219
sub _create_file {
217
sub _create_file {
220
    my ( $self, $filename ) = @_;
218
    my ( $self, $filename ) = @_;
221
    my $fh;
219
222
    if( $self->{files}->{$filename} &&
220
    return if ($self->{files}->{$filename} && $self->{files}->{$filename}->{errcode});
223
            $self->{files}->{$filename}->{errcode} ) {
221
    my $hashval = $self->{files}->{$filename}->{hash};
224
        #skip
222
    my $filepath = $self->{storage}->filepath({
225
    } elsif( !$self->{temporary} && !$self->{rootdir} ) {
223
        hashvalue => $hashval,
226
        $self->{files}->{$filename}->{errcode} = ERR_ROOT; #no rootdir
224
        filename => $filename,
227
    } elsif( $self->{temporary} && !$self->{tmpdir} ) {
225
        dir => $self->{dir},
228
        $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;
229
    } else {
242
    } else {
230
        my $dir = $self->_dir;
243
        $self->{files}->{$filename}->{errcode} = ERR_PERMS; #not writable
231
        my $hashval = $self->{files}->{$filename}->{hash};
232
        my $fn = $hashval. '_'. $filename;
233
234
        # if the file exists and it is registered, then set error
235
        # if it exists, but is not in the database, we will overwrite
236
        if( -e "$dir/$fn" &&
237
        Koha::UploadedFiles->search({
238
            hashvalue          => $hashval,
239
            uploadcategorycode => $self->{category},
240
        })->count ) {
241
            $self->{files}->{$filename}->{errcode} = ERR_EXISTS;
242
            return;
243
        }
244
245
        $fh = IO::File->new( "$dir/$fn", "w");
246
        if( $fh ) {
247
            $fh->binmode;
248
            $self->{files}->{$filename}->{fh}= $fh;
249
        } else {
250
            $self->{files}->{$filename}->{errcode} = ERR_PERMS;
251
        }
252
    }
244
    }
253
    return $fh;
254
}
255
245
256
sub _dir {
246
    return $fh;
257
    my ( $self ) = @_;
258
    my $dir = $self->{temporary}? $self->{tmpdir}: $self->{rootdir};
259
    $dir.= '/'. $self->{category};
260
    mkdir $dir if !-d $dir;
261
    return $dir;
262
}
247
}
263
248
264
sub _hook {
249
sub _hook {
Lines 283-296 sub _done { Link Here
283
sub _register {
268
sub _register {
284
    my ( $self, $filename, $size ) = @_;
269
    my ( $self, $filename, $size ) = @_;
285
    my $rec = Koha::UploadedFile->new({
270
    my $rec = Koha::UploadedFile->new({
271
        storage   => $self->{storage}->{name},
286
        hashvalue => $self->{files}->{$filename}->{hash},
272
        hashvalue => $self->{files}->{$filename}->{hash},
287
        filename  => $filename,
273
        filename  => $filename,
288
        dir       => $self->{category},
274
        dir       => $self->{dir},
289
        filesize  => $size,
275
        filesize  => $size,
290
        owner     => $self->{uid},
276
        owner     => $self->{uid},
291
        uploadcategorycode => $self->{category},
292
        public    => $self->{public},
277
        public    => $self->{public},
293
        permanent => $self->{temporary}? 0: 1,
278
        permanent => $self->{storage}->{temporary} ? 0 : 1,
294
    })->store;
279
    })->store;
295
    $self->{files}->{$filename}->{id} = $rec->id if $rec;
280
    $self->{files}->{$filename}->{id} = $rec->id if $rec;
296
}
281
}
Lines 300-310 sub _compute { Link Here
300
# For temporary files, the id is made unique with time
285
# For temporary files, the id is made unique with time
301
    my ( $self, $name, $block ) = @_;
286
    my ( $self, $name, $block ) = @_;
302
    if( !$self->{files}->{$name}->{hash} ) {
287
    if( !$self->{files}->{$name}->{hash} ) {
303
        my $str = $name. ( $self->{uid} // '0' ).
288
        my $str = $name . ( $self->{uid} // '0' ) .
304
            ( $self->{temporary}? Time::HiRes::time(): '' ).
289
            ( $self->{storage}->{temporary} ? Time::HiRes::time() : '' ) .
305
            $self->{category}. substr( $block, 0, BYTES_DIGEST );
290
            $self->{storage}->{name} . $self->{dir} .
291
            substr( $block, 0, BYTES_DIGEST );
306
        # since Digest cannot handle wide chars, we need to encode here
292
        # since Digest cannot handle wide chars, we need to encode here
307
        # there could be a wide char in the filename or the category
293
        # there could be a wide char in the filename
308
        my $h = Digest::MD5::md5_hex( Encode::encode_utf8( $str ) );
294
        my $h = Digest::MD5::md5_hex( Encode::encode_utf8( $str ) );
309
        $self->{files}->{$name}->{hash} = $h;
295
        $self->{files}->{$name}->{hash} = $h;
310
    }
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.pl (+41 lines)
Line 0 Link Here
1
use Modern::Perl;
2
3
return {
4
    bug_number => '19318',
5
    description => 'Add uploaded_files.storage and remove uploaded_files.uploadcategorycode',
6
    up => sub {
7
        my ($args) = @_;
8
        my ($dbh, $out) = @$args{qw(dbh out)};
9
10
        unless (column_exists('uploaded_files', 'storage')) {
11
            $dbh->do(q{
12
                ALTER TABLE uploaded_files
13
                ADD COLUMN storage VARCHAR(255) NULL DEFAULT NULL AFTER id
14
            });
15
        }
16
17
        if (column_exists('uploaded_files', 'uploadcategorycode')) {
18
            $dbh->do(q{
19
                ALTER TABLE uploaded_files
20
                DROP COLUMN uploadcategorycode
21
            });
22
        }
23
24
        $dbh->do(q{
25
            UPDATE uploaded_files
26
            SET storage = IF(permanent, 'DEFAULT', 'TMP')
27
            WHERE storage IS NULL OR storage = ''
28
        });
29
30
        $dbh->do(q{
31
            UPDATE uploaded_files
32
            SET dir = ''
33
            WHERE storage = 'TMP'
34
        });
35
36
        $dbh->do(q{
37
            ALTER TABLE uploaded_files
38
            MODIFY COLUMN storage VARCHAR(255) NOT NULL
39
        });
40
    },
41
}
(-)a/installer/data/mysql/kohastructure.sql (-1 / +1 lines)
Lines 5160-5171 DROP TABLE IF EXISTS `uploaded_files`; Link Here
5160
/*!40101 SET character_set_client = utf8 */;
5160
/*!40101 SET character_set_client = utf8 */;
5161
CREATE TABLE `uploaded_files` (
5161
CREATE TABLE `uploaded_files` (
5162
  `id` int(11) NOT NULL AUTO_INCREMENT,
5162
  `id` int(11) NOT NULL AUTO_INCREMENT,
5163
  `storage` varchar(255) NOT NULL,
5163
  `hashvalue` char(40) COLLATE utf8mb4_unicode_ci NOT NULL,
5164
  `hashvalue` char(40) COLLATE utf8mb4_unicode_ci NOT NULL,
5164
  `filename` mediumtext COLLATE utf8mb4_unicode_ci NOT NULL,
5165
  `filename` mediumtext COLLATE utf8mb4_unicode_ci NOT NULL,
5165
  `dir` mediumtext COLLATE utf8mb4_unicode_ci NOT NULL,
5166
  `dir` mediumtext COLLATE utf8mb4_unicode_ci NOT NULL,
5166
  `filesize` int(11) DEFAULT NULL,
5167
  `filesize` int(11) DEFAULT NULL,
5167
  `dtcreated` timestamp NOT NULL DEFAULT current_timestamp() ON UPDATE current_timestamp(),
5168
  `dtcreated` timestamp NOT NULL DEFAULT current_timestamp() ON UPDATE current_timestamp(),
5168
  `uploadcategorycode` text COLLATE utf8mb4_unicode_ci DEFAULT NULL,
5169
  `owner` int(11) DEFAULT NULL,
5169
  `owner` int(11) DEFAULT NULL,
5170
  `public` tinyint(4) DEFAULT NULL,
5170
  `public` tinyint(4) DEFAULT NULL,
5171
  `permanent` tinyint(4) DEFAULT NULL,
5171
  `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 436-442 Link Here
436
            $('#profile_fieldset').hide();
436
            $('#profile_fieldset').hide();
437
            $("#fileuploadstatus").show();
437
            $("#fileuploadstatus").show();
438
            $("#uploadedfileid").val('');
438
            $("#uploadedfileid").val('');
439
            xhr= AjaxUpload( $('#fileToUpload'), $('#fileuploadprogress'), 'temp=1', cbUpload );
439
            xhr= AjaxUpload( $('#fileToUpload'), $('#fileuploadprogress'), 'storage=TMP', cbUpload );
440
            $("#fileuploadcancel").show();
440
            $("#fileuploadcancel").show();
441
        }
441
        }
442
        function CancelUpload() {
442
        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 (-51 / +68 lines)
Lines 1-9 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 KohaDates %]
5
[% USE KohaDates %]
5
[% USE TablesSettings %]
6
[% USE TablesSettings %]
6
[% USE AuthorisedValues %]
7
[% USE AuthorisedValues %]
8
[% USE JSON.Escape %]
7
[% SET footerjs = 1 %]
9
[% SET footerjs = 1 %]
8
[% INCLUDE 'doc-head-open.inc' %]
10
[% INCLUDE 'doc-head-open.inc' %]
9
[% IF plugin %]
11
[% IF plugin %]
Lines 13-18 Link Here
13
[% END %]
15
[% END %]
14
[% INCLUDE 'doc-head-close.inc' %]
16
[% INCLUDE 'doc-head-close.inc' %]
15
17
18
[% BLOCK storage_label %]
19
    [% SWITCH name %]
20
        [% CASE 'TMP' %]Temporary
21
        [% CASE 'DEFAULT' %]Default
22
        [% CASE %][% name | html %]
23
    [% END %]
24
[% END %]
25
16
[% BLOCK plugin_pars %]
26
[% BLOCK plugin_pars %]
17
    [% IF plugin %]
27
    [% IF plugin %]
18
        <input type="hidden" name="plugin" value="1" />
28
        <input type="hidden" name="plugin" value="1" />
Lines 57-91 Link Here
57
            <input type="file" id="fileToUpload" name="fileToUpload" multiple/>
67
            <input type="file" id="fileToUpload" name="fileToUpload" multiple/>
58
        </div>
68
        </div>
59
        </li>
69
        </li>
60
        [% IF uploadcategories %]
70
        <li>
61
            <li>
71
            <label for="storage">Storage: </label>
62
                <label for="uploadcategory">Category: </label>
72
            <select id="storage" name="storage">
63
                <select id="uploadcategory" name="uploadcategory">
73
                [% FOREACH storage IN storages %]
64
                [% IF !plugin %]
74
                    [% UNLESS plugin && storage.temporary %]
65
                    <option value=""></option>
75
                        <option value="[% storage.name | html %]">[% PROCESS storage_label name=storage.name %]</option>
66
                [% END %]
67
                [% FOREACH cat IN uploadcategories %]
68
                    <option value="[% cat.code | html %]">[% cat.name | html %]</option>
69
                [% END %]
70
                </select>
71
            </li>
72
        [% END %]
73
        [% IF !plugin %]
74
            <li>
75
            [% IF uploadcategories %]
76
                <div class="hint">Note: For temporary uploads do not select a category.</div>
77
            [% ELSE %]
78
                <div class="hint">
79
                    Note: No upload categories are defined.
80
                    [% IF ( CAN_user_parameters_manage_auth_values ) -%]
81
                        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.
82
                    [% ELSE -%]
83
                        An administrator must add values to the UPLOAD authorized value category otherwise all uploads will be marked as temporary.
84
                    [% END %]
76
                    [% END %]
85
                </div>
77
                [% END %]
86
            [% END %]
78
            </select>
87
            </li>
79
        </li>
88
        [% END %]
80
        <li>
81
            <label for="dir">Directory: </label>
82
            <select id="dir" name="dir">
83
            </select>
84
        </li>
89
        <li>
85
        <li>
90
            [% IF plugin %]
86
            [% IF plugin %]
91
                <input type="hidden" id="public" name="public" value="1"/>
87
                <input type="hidden" id="public" name="public" value="1"/>
Lines 204-212 Link Here
204
        <th>Size</th>
200
        <th>Size</th>
205
        <th>Hashvalue</th>
201
        <th>Hashvalue</th>
206
        <th>Date added</th>
202
        <th>Date added</th>
207
        <th>Category</th>
203
        <th>Storage</th>
208
        [% IF !plugin %]<th>Public</th>[% END %]
204
        <th>Directory</th>
209
        [% IF !plugin %]<th>Temporary</th>[% END %]
205
        [% IF !plugin %]
206
            <th>Public</th>
207
            <th>Temporary</th>
208
        [% END %]
210
        <th class="NoSort noExport">Actions</th>
209
        <th class="NoSort noExport">Actions</th>
211
    </tr>
210
    </tr>
212
    </thead>
211
    </thead>
Lines 217-225 Link Here
217
        <td>[% record.filesize | html %]</td>
216
        <td>[% record.filesize | html %]</td>
218
        <td>[% record.hashvalue | html %]</td>
217
        <td>[% record.hashvalue | html %]</td>
219
        <td data-order="[% record.dtcreated | html %]">[% record.dtcreated | $KohaDates with_hours = 1 %]</td>
218
        <td data-order="[% record.dtcreated | html %]">[% record.dtcreated | $KohaDates with_hours = 1 %]</td>
220
        <td>
219
        <td>[% PROCESS storage_label name=record.storage %]</td>
221
            <a href="/cgi-bin/koha/tools/upload.pl?op=browse&browsecategory=[% record.uploadcategorycode | uri %]">[% AuthorisedValues.GetByCode( 'UPLOAD', record.uploadcategorycode ) | html %]</a>
220
        <td>[% record.dir | html %]</td>
222
        </td>
223
        [% IF !plugin %]
221
        [% IF !plugin %]
224
            <td>
222
            <td>
225
                [% IF record.public %]
223
                [% IF record.public %]
Lines 232-238 Link Here
232
        [% END %]
230
        [% END %]
233
        <td class="actions">
231
        <td class="actions">
234
            [% IF plugin %]
232
            [% IF plugin %]
235
                <button class="btn btn-default btn-xs choose_entry" data-record-hashvalue="[% record.hashvalue | html %]"><i class="fa fa-plus"></i> Choose</button>
233
                <button class="btn btn-default btn-xs choose_entry" data-record-url="[% record.url | html %]"><i class="fa fa-plus"></i> Choose</button>
236
            [% END %]
234
            [% END %]
237
            <button class="btn btn-default btn-xs download_entry" data-record-id="[% record.id | html %]"><i class="fa fa-download"></i> Download</button>
235
            <button class="btn btn-default btn-xs download_entry" data-record-id="[% record.id | html %]"><i class="fa fa-download"></i> Download</button>
238
            [% IF record.owner == owner || CAN_user_tools_upload_manage %]
236
            [% IF record.owner == owner || CAN_user_tools_upload_manage %]
Lines 348-364 Link Here
348
            $("#searchfile").hide();
346
            $("#searchfile").hide();
349
            $("#lastbreadcrumb").text( _("Add a new upload") );
347
            $("#lastbreadcrumb").text( _("Add a new upload") );
350
348
351
            var cat, xtra='';
349
            var xtra = 'storage=' + $('#storage').val();
352
            if( $("#uploadcategory").val() )
350
            xtra = xtra + '&dir=' + $('#dir').val();
353
                cat = encodeURIComponent( $("#uploadcategory").val() );
354
            if( cat ) xtra= 'category=' + cat + '&';
355
            [% IF plugin %]
351
            [% IF plugin %]
356
                xtra = xtra + 'public=1&temp=0';
352
                xtra = xtra + '&public=1';
357
            [% ELSE %]
353
            [% ELSE %]
358
                if( !cat ) xtra = 'temp=1&';
354
                if ( $('#public').prop('checked') ) {
359
                if( $('#public').prop('checked') ) xtra = xtra + 'public=1';
355
                    xtra = xtra + '&public=1';
356
                }
360
            [% END %]
357
            [% END %]
361
            xhr= AjaxUpload( $('#fileToUpload'), $('#fileuploadprogress'), xtra, cbUpload );
358
            xhr = AjaxUpload( $('#fileToUpload'), $('#fileuploadprogress'), xtra, cbUpload );
362
        }
359
        }
363
        function CancelUpload() {
360
        function CancelUpload() {
364
            if( xhr ) xhr.abort();
361
            if( xhr ) xhr.abort();
Lines 401-407 Link Here
401
            var rv;
398
            var rv;
402
            switch(code) {
399
            switch(code) {
403
                case 'UPLERR_ALREADY_EXISTS':
400
                case 'UPLERR_ALREADY_EXISTS':
404
                    rv = _("This file already exists (in this category).");
401
                    rv = _("This file already exists (in this storage).");
405
                    break;
402
                    break;
406
                case 'UPLERR_CANNOT_WRITE':
403
                case 'UPLERR_CANNOT_WRITE':
407
                    rv = _("File could not be created. Check permissions.");
404
                    rv = _("File could not be created. Check permissions.");
Lines 450-461 Link Here
450
                $(window.opener.document).find('#[% index | html %]').val( '' );
447
                $(window.opener.document).find('#[% index | html %]').val( '' );
451
            [% END %]
448
            [% END %]
452
        }
449
        }
453
        function Choose(hashval) {
450
        function Choose(url) {
454
            var res = '[% Koha.Preference('OPACBaseURL') | html %]';
455
            res = res.replace( /\/$/, '');
456
            res = res + '/cgi-bin/koha/opac-retrieve-file.pl?id=' + hashval;
457
            [% IF index %]
451
            [% IF index %]
458
                $(window.opener.document).find('#[% index | html %]').val( res );
452
                $(window.opener.document).find('#[% index | html %]').val( url );
459
            [% END %]
453
            [% END %]
460
            window.close();
454
            window.close();
461
        }
455
        }
Lines 484-491 Link Here
484
            });
478
            });
485
            $("#uploadresults tbody").on("click",".choose_entry",function(e){
479
            $("#uploadresults tbody").on("click",".choose_entry",function(e){
486
                e.preventDefault();
480
                e.preventDefault();
487
                var record_hashvalue = $(this).data("record-hashvalue");
481
                var record_url = $(this).data("record-url");
488
                Choose( record_hashvalue );
482
                Choose( record_url );
489
            });
483
            });
490
            $("#uploadresults tbody").on("click",".download_entry",function(e){
484
            $("#uploadresults tbody").on("click",".download_entry",function(e){
491
                e.preventDefault();
485
                e.preventDefault();
Lines 519-524 Link Here
519
            }
513
            }
520
        });
514
        });
521
    </script>
515
    </script>
516
    <script>
517
        [% FOREACH storage IN storages %]
518
            [% name = storage.name %]
519
            [% storage_directories.$name = storage.directories %]
520
        [% END %]
521
522
        $(document).ready(function () {
523
            let storage_directories = [% To.json(storage_directories) | $raw %];
524
            $('#storage').on('change', function () {
525
                $('#dir').empty();
526
                $('#dir').append($('<option>').val('').html(_("(root)")));
527
                let name = $(this).val()
528
                if (name in storage_directories) {
529
                    storage_directories[name].forEach(function (dir) {
530
                        let option = $('<option>')
531
                            .val(dir)
532
                            .html(dir);
533
                        $('#dir').append(option);
534
                    })
535
                }
536
            }).change();
537
        });
538
    </script>
522
[% END %]
539
[% END %]
523
540
524
[% INCLUDE 'intranet-bottom.inc' %]
541
[% 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 184-190 my $batch3_results = $dbh->do('SELECT * FROM import_batches WHERE import_batch_i Link Here
184
is( $batch3_results, "0E0", "Batch 3 has been deleted");
184
is( $batch3_results, "0E0", "Batch 3 has been deleted");
185
185
186
subtest "RecordsFromMarcPlugin" => sub {
186
subtest "RecordsFromMarcPlugin" => sub {
187
    plan tests => 5;
187
    plan tests => 6;
188
188
189
    # Create a test file
189
    # Create a test file
190
    my ( $fh, $name ) = tempfile();
190
    my ( $fh, $name ) = tempfile();
Lines 212-217 subtest "RecordsFromMarcPlugin" => sub { Link Here
212
        'Checked one field in first record' );
212
        'Checked one field in first record' );
213
    is( $records->[1]->subfield('100', 'a'), 'Another',
213
    is( $records->[1]->subfield('100', 'a'), 'Another',
214
        'Checked one field in second record' );
214
        'Checked one field in second record' );
215
216
    open my $fh2, '<', $name;
217
    $records = C4::ImportBatch::RecordsFromMarcPlugin( $fh2, ref $plugin, 'UTF-8' );
218
    close $fh2;
219
    is( @$records, 2, 'Can take a filehandle as parameter' );
215
};
220
};
216
221
217
$schema->storage->txn_rollback;
222
$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 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 C4::Context and CGI
51
# Redirect upload dir structure and mock C4::Context 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( 'C4::Context' );
64
my $specmod = Test::MockModule->new( 'C4::Context' );
55
$specmod->mock( 'temporary_directory' => sub { return $tempdir; } );
65
$specmod->mock( 'temporary_directory' => 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( C4::Context::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, 'Delete successful' );
187
    ok( $delete, '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 198-205 subtest 'Test delete_missing' => sub { Link Here
198
    plan tests => 5;
211
    plan tests => 5;
199
212
200
    # If we add files via TestBuilder, they do not exist
213
    # If we add files via TestBuilder, they do not exist
201
    my $upload01 = $builder->build({ source => 'UploadedFile' });
214
    my $upload01 = $builder->build({ source => 'UploadedFile', value => {storage => 'TMP'} });
202
    my $upload02 = $builder->build({ source => 'UploadedFile' });
215
    my $upload02 = $builder->build({ source => 'UploadedFile', value => {storage => 'TMP'} });
203
    # dry run first
216
    # dry run first
204
    my $deleted = Koha::UploadedFiles->delete_missing({ keep_record => 1 });
217
    my $deleted = Koha::UploadedFiles->delete_missing({ keep_record => 1 });
205
    is( $deleted, 2, 'Expect two records with missing files' );
218
    is( $deleted, 2, 'Expect two records with missing files' );
Lines 226-240 subtest 'Call search_term with[out] private flag' => sub { Link Here
226
    })->count, 4, 'Returns now four results' );
239
    })->count, 4, 'Returns now four results' );
227
};
240
};
228
241
229
subtest 'Simple tests for httpheaders and getCategories' => sub {
242
subtest 'Simple tests for httpheaders' => sub {
230
    plan tests => 2;
243
    plan tests => 1;
231
244
232
    my $rec = Koha::UploadedFiles->search_term({ term => 'file' })->next;
245
    my $rec = Koha::UploadedFiles->search_term({ term => 'file' })->next;
233
    my @hdrs = $rec->httpheaders;
246
    my @hdrs = $rec->httpheaders;
234
    is( @hdrs == 4 && $hdrs[1] =~ /application\/octet-stream/, 1, 'Simple test for httpheaders');
247
    is( @hdrs == 4 && $hdrs[1] =~ /application\/octet-stream/, 1, 'Simple test for httpheaders');
235
    $builder->build({ source => 'AuthorisedValue', value => { category => 'UPLOAD', authorised_value => 'HAVE_AT_LEAST_ONE', lib => 'Hi there' } });
248
    $builder->build({ source => 'AuthorisedValue', value => { category => 'UPLOAD', authorised_value => 'HAVE_AT_LEAST_ONE', lib => 'Hi there' } });
236
    my $cat = Koha::UploadedFiles->getCategories;
237
    is( @$cat >= 1, 1, 'getCategories returned at least one category' );
238
};
249
};
239
250
240
subtest 'Testing allows_add_by' => sub {
251
subtest 'Testing allows_add_by' => sub {
Lines 279-285 subtest 'Testing delete_temporary' => sub { Link Here
279
    plan tests => 9;
290
    plan tests => 9;
280
291
281
    # Add two temporary files: result should be 3 + 3
292
    # Add two temporary files: result should be 3 + 3
282
    Koha::Uploader->new({ tmp => 1 })->cgi; # add file6 and file7
293
    Koha::Uploader->new({
294
        storage => $uploads->[$current_upload]->[0]->{storage},
295
        dir => $uploads->[$current_upload]->[0]->{dir},
296
    })->cgi; # add file6 and file7
283
    is( Koha::UploadedFiles->search->count, 6, 'Test starting count' );
297
    is( Koha::UploadedFiles->search->count, 6, 'Test starting count' );
284
    is( Koha::UploadedFiles->search({ permanent => 1 })->count, 3,
298
    is( Koha::UploadedFiles->search({ permanent => 1 })->count, 3,
285
        'Includes 3 permanent' );
299
        'Includes 3 permanent' );
(-)a/tools/stage-marc-import.pl (-4 / +5 lines)
Lines 87-103 if ($completedJobID) { Link Here
87
    $template->param(map { $_ => $results->{$_} } keys %{ $results });
87
    $template->param(map { $_ => $results->{$_} } keys %{ $results });
88
} elsif ($fileID) {
88
} elsif ($fileID) {
89
    my $upload = Koha::UploadedFiles->find( $fileID );
89
    my $upload = Koha::UploadedFiles->find( $fileID );
90
    my $file = $upload->full_path;
90
    my $storage = Koha::Storage->get_instance($upload->storage);
91
    my $fh = $storage->fh($upload->filepath, 'r');
91
    my $filename = $upload->filename;
92
    my $filename = $upload->filename;
92
93
93
    my ( $errors, $marcrecords );
94
    my ( $errors, $marcrecords );
94
    if( $format eq 'MARCXML' ) {
95
    if( $format eq 'MARCXML' ) {
95
        ( $errors, $marcrecords ) = C4::ImportBatch::RecordsFromMARCXMLFile( $file, $encoding);
96
        ( $errors, $marcrecords ) = C4::ImportBatch::RecordsFromMARCXMLFile( $fh, $encoding);
96
    } elsif( $format eq 'ISO2709' ) {
97
    } elsif( $format eq 'ISO2709' ) {
97
        ( $errors, $marcrecords ) = C4::ImportBatch::RecordsFromISO2709File( $file, $record_type, $encoding );
98
        ( $errors, $marcrecords ) = C4::ImportBatch::RecordsFromISO2709File( $fh, $record_type, $encoding );
98
    } else { # plugin based
99
    } else { # plugin based
99
        $errors = [];
100
        $errors = [];
100
        $marcrecords = C4::ImportBatch::RecordsFromMarcPlugin( $file, $format, $encoding );
101
        $marcrecords = C4::ImportBatch::RecordsFromMarcPlugin( $fh, $format, $encoding );
101
    }
102
    }
102
    warn "$filename: " . ( join ',', @$errors ) if @$errors;
103
    warn "$filename: " . ( join ',', @$errors ) if @$errors;
103
        # no need to exit if we have no records (or only errors) here
104
        # 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 122-132 if ($fileID) { Link Here
122
        undef $srcimage;
123
        undef $srcimage;
123
    }
124
    }
124
    else {
125
    else {
125
        my $filename = $upload->full_path;
126
        my $storage = Koha::Storage->get_instance($upload->storage);
127
        my $fh = $storage->fh($upload->filepath, 'r');
126
        my $dirname = File::Temp::tempdir( CLEANUP => 1 );
128
        my $dirname = File::Temp::tempdir( CLEANUP => 1 );
127
        qx/unzip $filename -d $dirname/;
129
        my $zip = Archive::Zip->new();
128
        my $exit_code = $?;
130
        $zip->readFromFileHandle($fh);
129
        unless ( $exit_code == 0 ) {
131
        unless (AZ_OK == $zip->extractTree(undef, $dirname)) {
130
            $error = 'UZIPFAIL';
132
            $error = 'UZIPFAIL';
131
        }
133
        }
132
        else {
134
        else {
Lines 165-170 if ($fileID) { Link Here
165
                            $error = 'DELERR';
167
                            $error = 'DELERR';
166
                        }
168
                        }
167
                        else {
169
                        else {
170
                            my $filename;
168
                            ( $biblionumber, $filename ) = split $delim, $line, 2;
171
                            ( $biblionumber, $filename ) = split $delim, $line, 2;
169
                            $biblionumber =~
172
                            $biblionumber =~
170
                              s/[\"\r\n]//g;    # remove offensive characters
173
                              s/[\"\r\n]//g;    # remove offensive characters
Lines 212-217 if ($fileID) { Link Here
212
                }
215
                }
213
            }
216
            }
214
        }
217
        }
218
        close $fh;
215
    }
219
    }
216
220
217
    $template->param(
221
    $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 qw( get_template_and_user );
24
use C4::Auth qw( get_template_and_user );
25
use C4::Context;
25
use C4::Output qw( output_html_with_http_headers );
26
use C4::Output qw( output_html_with_http_headers );
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 82-96 if ( $op eq 'new' ) { Link Here
82
        my @id = split /,/, $id;
90
        my @id = split /,/, $id;
83
        foreach my $recid (@id) {
91
        foreach my $recid (@id) {
84
            my $rec = Koha::UploadedFiles->find( $recid );
92
            my $rec = Koha::UploadedFiles->find( $recid );
85
            push @$uploads, $rec->unblessed
93
            push @$uploads, $rec
86
                if $rec && ( $rec->public || !$plugin );
94
                if $rec && ( $rec->public || !$plugin );
87
                # Do not show private uploads in the plugin mode (:editor)
95
                # Do not show private uploads in the plugin mode (:editor)
88
        }
96
        }
89
    } else {
97
    } else {
90
        $uploads = Koha::UploadedFiles->search_term({
98
        $uploads = [ Koha::UploadedFiles->search_term({
91
            term => $term,
99
            term => $term,
92
            $plugin? (): ( include_private => 1 ),
100
            $plugin? (): ( include_private => 1 ),
93
        })->unblessed;
101
        }) ];
94
    }
102
    }
95
103
96
    $template->param(
104
    $template->param(
97
- 

Return to bug 19318