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

(-)a/Koha/File/Transport.pm (-1 / +19 lines)
Lines 73-79 sub store { Link Here
73
    $self->SUPER::store;
73
    $self->SUPER::store;
74
74
75
    # Subclass triggers
75
    # Subclass triggers
76
    my $subclass = $self->transport eq 'sftp' ? 'Koha::File::Transport::SFTP' : 'Koha::File::Transport::FTP';
76
    my $subclass_map = {
77
        'sftp'  => 'Koha::File::Transport::SFTP',
78
        'ftp'   => 'Koha::File::Transport::FTP',
79
        'local' => 'Koha::File::Transport::Local',
80
    };
81
    my $subclass = $subclass_map->{ $self->transport } || 'Koha::File::Transport';
77
    $self = $subclass->_new_from_dbic( $self->_result );
82
    $self = $subclass->_new_from_dbic( $self->_result );
78
    $self->_post_store_trigger;
83
    $self->_post_store_trigger;
79
84
Lines 246-251 sub list_files { Link Here
246
    die "Subclass must implement list_files";
251
    die "Subclass must implement list_files";
247
}
252
}
248
253
254
=head3 rename_file
255
256
    my $success = $transport->rename_file($old_name, $new_name);
257
258
Method for renaming a file on the current file server
259
260
=cut
261
262
sub rename_file {
263
    my ( $self, $old_name, $new_name ) = @_;
264
    die "Subclass must implement rename_file";
265
}
266
249
=head3 _post_store_trigger
267
=head3 _post_store_trigger
250
268
251
    $server->_post_store_trigger;
269
    $server->_post_store_trigger;
(-)a/Koha/File/Transport/FTP.pm (+26 lines)
Lines 162-167 sub list_files { Link Here
162
    return $file_list;
162
    return $file_list;
163
}
163
}
164
164
165
=head3 rename_file
166
167
    my $success = $server->rename_file($old_name, $new_name);
168
169
Renames a file on the server connection.
170
171
Returns true on success or undefined on failure.
172
173
=cut
174
175
sub rename_file {
176
    my ( $self, $old_name, $new_name ) = @_;
177
178
    $self->{connection}->rename( $old_name, $new_name ) or return $self->_abort_operation();
179
180
    $self->add_message(
181
        {
182
            message => "File rename succeeded",
183
            type    => 'success',
184
            payload => { detail => "$old_name -> $new_name" }
185
        }
186
    );
187
188
    return 1;
189
}
190
165
sub _abort_operation {
191
sub _abort_operation {
166
    my ( $self, $message ) = @_;
192
    my ( $self, $message ) = @_;
167
193
(-)a/Koha/File/Transport/Local.pm (+382 lines)
Line 0 Link Here
1
package Koha::File::Transport::Local;
2
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it
6
# under the terms of the GNU General Public License as published by
7
# the Free Software Foundation; either version 3 of the License, or
8
# (at your option) any later version.
9
#
10
# Koha is distributed in the hope that it will be useful, but
11
# WITHOUT ANY WARRANTY; without even the implied warranty of
12
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13
# GNU General Public License for more details.
14
#
15
# You should have received a copy of the GNU General Public License
16
# along with Koha; if not, see <http://www.gnu.org/licenses>.
17
18
use Modern::Perl;
19
use File::Copy qw( copy move );
20
use File::Spec;
21
use IO::Dir;
22
23
use base qw(Koha::File::Transport);
24
25
=head1 NAME
26
27
Koha::File::Transport::Local - Local file system implementation of file transport
28
29
=head2 Class methods
30
31
=head3 connect
32
33
    my $success = $self->connect;
34
35
Validates that the configured directories exist and have appropriate permissions.
36
37
=cut
38
39
sub connect {
40
    my ($self) = @_;
41
    my $operation = "connection";
42
43
    # Check download directory if configured
44
    if ( my $download_dir = $self->download_directory ) {
45
        unless ( -d $download_dir ) {
46
            $self->add_message(
47
                {
48
                    message => $operation,
49
                    type    => 'error',
50
                    payload => {
51
                        error => "Download directory does not exist: $download_dir",
52
                        path  => $download_dir
53
                    }
54
                }
55
            );
56
            return;
57
        }
58
59
        unless ( -r $download_dir ) {
60
            $self->add_message(
61
                {
62
                    message => $operation,
63
                    type    => 'error',
64
                    payload => {
65
                        error => "Download directory is not readable: $download_dir",
66
                        path  => $download_dir
67
                    }
68
                }
69
            );
70
            return;
71
        }
72
    }
73
74
    # Check upload directory if configured
75
    if ( my $upload_dir = $self->upload_directory ) {
76
        unless ( -d $upload_dir ) {
77
            $self->add_message(
78
                {
79
                    message => $operation,
80
                    type    => 'error',
81
                    payload => {
82
                        error => "Upload directory does not exist: $upload_dir",
83
                        path  => $upload_dir
84
                    }
85
                }
86
            );
87
            return;
88
        }
89
90
        unless ( -w $upload_dir ) {
91
            $self->add_message(
92
                {
93
                    message => $operation,
94
                    type    => 'error',
95
                    payload => {
96
                        error => "Upload directory is not writable: $upload_dir",
97
                        path  => $upload_dir
98
                    }
99
                }
100
            );
101
            return;
102
        }
103
    }
104
105
    $self->add_message(
106
        {
107
            message => $operation,
108
            type    => 'success',
109
            payload => {
110
                status             => 'connected',
111
                download_directory => $self->download_directory,
112
                upload_directory   => $self->upload_directory
113
            }
114
        }
115
    );
116
117
    return 1;
118
}
119
120
=head3 upload_file
121
122
    my $success =  $transport->upload_file($local_file, $remote_file);
123
124
Copies a local file to the upload directory.
125
126
Returns true on success or undefined on failure.
127
128
=cut
129
130
sub upload_file {
131
    my ( $self, $local_file, $remote_file ) = @_;
132
    my $operation = "upload";
133
134
    my $upload_dir  = $self->upload_directory || $self->{current_directory} || '.';
135
    my $destination = File::Spec->catfile( $upload_dir, $remote_file );
136
137
    unless ( copy( $local_file, $destination ) ) {
138
        $self->add_message(
139
            {
140
                message => $operation,
141
                type    => 'error',
142
                payload => {
143
                    error => $!,
144
                    path  => $destination
145
                }
146
            }
147
        );
148
        return;
149
    }
150
151
    $self->add_message(
152
        {
153
            message => $operation,
154
            type    => 'success',
155
            payload => { path => $destination }
156
        }
157
    );
158
159
    return 1;
160
}
161
162
=head3 download_file
163
164
    my $success =  $transport->download_file($remote_file, $local_file);
165
166
Copies a file from the download directory to a local file.
167
168
Returns true on success or undefined on failure.
169
170
=cut
171
172
sub download_file {
173
    my ( $self, $remote_file, $local_file ) = @_;
174
    my $operation = 'download';
175
176
    my $download_dir = $self->download_directory || $self->{current_directory} || '.';
177
    my $source       = File::Spec->catfile( $download_dir, $remote_file );
178
179
    unless ( -f $source ) {
180
        $self->add_message(
181
            {
182
                message => $operation,
183
                type    => 'error',
184
                payload => {
185
                    error => "File not found: $source",
186
                    path  => $source
187
                }
188
            }
189
        );
190
        return;
191
    }
192
193
    unless ( copy( $source, $local_file ) ) {
194
        $self->add_message(
195
            {
196
                message => $operation,
197
                type    => 'error',
198
                payload => {
199
                    error => $!,
200
                    path  => $source
201
                }
202
            }
203
        );
204
        return;
205
    }
206
207
    $self->add_message(
208
        {
209
            message => $operation,
210
            type    => 'success',
211
            payload => { path => $source }
212
        }
213
    );
214
215
    return 1;
216
}
217
218
=head3 change_directory
219
220
    my $success = $server->change_directory($directory);
221
222
Sets the current working directory for file operations.
223
224
Returns true on success or undefined on failure.
225
226
=cut
227
228
sub change_directory {
229
    my ( $self, $remote_directory ) = @_;
230
    my $operation = 'change_directory';
231
232
    # For local file transport, we just track the current directory
233
    if ( $remote_directory && !-d $remote_directory ) {
234
        $self->add_message(
235
            {
236
                message => $operation,
237
                type    => 'error',
238
                payload => {
239
                    error => "Directory not found: $remote_directory",
240
                    path  => $remote_directory
241
                }
242
            }
243
        );
244
        return;
245
    }
246
247
    $self->{current_directory} = $remote_directory;
248
249
    $self->add_message(
250
        {
251
            message => $operation,
252
            type    => 'success',
253
            payload => { path => $remote_directory }
254
        }
255
    );
256
257
    return 1;
258
}
259
260
=head3 list_files
261
262
    my @files = $server->list_files;
263
264
Returns an array of filenames found in the current directory.
265
266
=cut
267
268
sub list_files {
269
    my ($self) = @_;
270
    my $operation = "list";
271
272
    my $directory = $self->download_directory || $self->{current_directory} || '.';
273
274
    unless ( -d $directory ) {
275
        $self->add_message(
276
            {
277
                message => $operation,
278
                type    => 'error',
279
                payload => {
280
                    error => "Directory not found: $directory",
281
                    path  => $directory
282
                }
283
            }
284
        );
285
        return;
286
    }
287
288
    my $dir_handle = IO::Dir->new($directory);
289
    unless ($dir_handle) {
290
        $self->add_message(
291
            {
292
                message => $operation,
293
                type    => 'error',
294
                payload => {
295
                    error => "Cannot open directory: $!",
296
                    path  => $directory
297
                }
298
            }
299
        );
300
        return;
301
    }
302
303
    my @files;
304
    while ( defined( my $file = $dir_handle->read ) ) {
305
        next if $file =~ /^\.\.?$/;                                 # Skip . and ..
306
        next unless -f File::Spec->catfile( $directory, $file );    # Only files
307
        push @files, $file;
308
    }
309
    $dir_handle->close;
310
311
    $self->add_message(
312
        {
313
            message => $operation,
314
            type    => 'success',
315
            payload => {
316
                path  => $directory,
317
                count => scalar @files
318
            }
319
        }
320
    );
321
322
    return \@files;
323
}
324
325
=head3 rename_file
326
327
    my $success = $server->rename_file($old_name, $new_name);
328
329
Renames a file in the current directory.
330
331
Returns true on success or undefined on failure.
332
333
=cut
334
335
sub rename_file {
336
    my ( $self, $old_name, $new_name ) = @_;
337
    my $operation = "rename";
338
339
    my $directory = $self->download_directory || $self->{current_directory} || '.';
340
    my $old_path  = File::Spec->catfile( $directory, $old_name );
341
    my $new_path  = File::Spec->catfile( $directory, $new_name );
342
343
    unless ( -f $old_path ) {
344
        $self->add_message(
345
            {
346
                message => $operation,
347
                type    => 'error',
348
                payload => {
349
                    error => "File not found: $old_path",
350
                    path  => $old_path
351
                }
352
            }
353
        );
354
        return;
355
    }
356
357
    unless ( move( $old_path, $new_path ) ) {
358
        $self->add_message(
359
            {
360
                message => $operation,
361
                type    => 'error',
362
                payload => {
363
                    error => $!,
364
                    path  => "$old_path -> $new_path"
365
                }
366
            }
367
        );
368
        return;
369
    }
370
371
    $self->add_message(
372
        {
373
            message => $operation,
374
            type    => 'success',
375
            payload => { path => "$old_path -> $new_path" }
376
        }
377
    );
378
379
    return 1;
380
}
381
382
1;
(-)a/Koha/File/Transport/SFTP.pm (+33 lines)
Lines 198-203 sub list_files { Link Here
198
    return $file_list;
198
    return $file_list;
199
}
199
}
200
200
201
=head3 rename_file
202
203
    my $success = $server->rename_file($old_name, $new_name);
204
205
Renames a file on the server connection.
206
207
Returns true on success or undefined on failure.
208
209
=cut
210
211
sub rename_file {
212
    my ( $self, $old_name, $new_name ) = @_;
213
    my $operation = "rename";
214
215
    $self->{connection}->rename( $old_name, $new_name )
216
        or return $self->_abort_operation( $operation, "$old_name -> $new_name" );
217
218
    $self->add_message(
219
        {
220
            message => $operation,
221
            type    => 'success',
222
            payload => {
223
                status => $self->{connection}->status,
224
                error  => $self->{connection}->error,
225
                path   => $self->{connection}->cwd,
226
                detail => "$old_name -> $new_name"
227
            }
228
        }
229
    );
230
231
    return 1;
232
}
233
201
=head2 Internal methods
234
=head2 Internal methods
202
235
203
=head3 _post_store_trigger
236
=head3 _post_store_trigger
(-)a/Koha/File/Transports.pm (-2 / +4 lines)
Lines 22-27 use Koha::Exceptions; Link Here
22
22
23
use Koha::File::Transport::SFTP;
23
use Koha::File::Transport::SFTP;
24
use Koha::File::Transport::FTP;
24
use Koha::File::Transport::FTP;
25
use Koha::File::Transport::Local;
25
26
26
use base qw(Koha::Objects);
27
use base qw(Koha::Objects);
27
28
Lines 61-68 Return the mapping for field value to class name for the polymorphic class Link Here
61
62
62
sub _polymorphic_map {
63
sub _polymorphic_map {
63
    return {
64
    return {
64
        sftp => 'Koha::File::Transport::SFTP',
65
        sftp  => 'Koha::File::Transport::SFTP',
65
        ftp  => 'Koha::File::Transport::FTP',
66
        ftp   => 'Koha::File::Transport::FTP',
67
        local => 'Koha::File::Transport::Local',
66
    };
68
    };
67
}
69
}
68
70
(-)a/t/db_dependent/Koha/File/Transports.t (-2 / +20 lines)
Lines 29-35 my $schema = Koha::Database->new->schema; Link Here
29
my $builder = t::lib::TestBuilder->new;
29
my $builder = t::lib::TestBuilder->new;
30
30
31
subtest 'Polymorphic object creation' => sub {
31
subtest 'Polymorphic object creation' => sub {
32
    plan tests => 4;
32
    plan tests => 6;
33
33
34
    $schema->storage->txn_begin;
34
    $schema->storage->txn_begin;
35
35
Lines 71-76 subtest 'Polymorphic object creation' => sub { Link Here
71
71
72
    can_ok( $ftp_transport, 'connect' );
72
    can_ok( $ftp_transport, 'connect' );
73
73
74
    # Test Local transport polymorphism
75
    my $local_transport = $builder->build_object(
76
        {
77
            class => 'Koha::File::Transports',
78
            value => {
79
                transport => 'local',
80
                name      => 'Test Local',
81
                host      => 'localhost',
82
            }
83
        }
84
    );
85
86
    is(
87
        ref($local_transport), 'Koha::File::Transport::Local',
88
        'Local transport should be polymorphic Koha::File::Transport::Local object'
89
    );
90
91
    can_ok( $local_transport, 'rename_file' );
92
74
    $schema->storage->txn_rollback;
93
    $schema->storage->txn_rollback;
75
};
94
};
76
95
77
- 

Return to bug 38489