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

(-)a/Koha/Edifact/Transport.pm (-322 / +109 lines)
Lines 21-49 use Modern::Perl; Link Here
21
21
22
use utf8;
22
use utf8;
23
23
24
use Carp qw( carp );
24
use Carp        qw( carp );
25
use DateTime;
26
use Encode      qw( from_to );
25
use Encode      qw( from_to );
27
use English     qw{ -no_match_vars };
28
use File::Copy  qw( copy move );
29
use File::Slurp qw( read_file );
26
use File::Slurp qw( read_file );
30
use Net::FTP;
31
use Net::SFTP::Foreign;
32
27
33
use Koha::Database;
28
use Koha::Database;
34
use Koha::DateUtils qw( dt_from_string );
29
use Koha::DateUtils qw( dt_from_string );
35
use Koha::Encryption;
30
use Koha::File::Transports;
36
31
37
sub new {
32
sub new {
38
    my ( $class, $account_id ) = @_;
33
    my ( $class, $account_id ) = @_;
39
    my $database = Koha::Database->new();
34
    my $database = Koha::Database->new();
40
    my $schema   = $database->schema();
35
    my $schema   = $database->schema();
41
    my $acct     = $schema->resultset('VendorEdiAccount')->find($account_id);
36
    my $acct     = $schema->resultset('VendorEdiAccount')->find($account_id);
42
    my $self     = {
37
43
        account       => $acct,
38
    # Get the file transport if configured
44
        schema        => $schema,
39
    my $file_transport = $acct->file_transport_id ? Koha::File::Transports->find( $acct->file_transport_id ) : undef;
45
        working_dir   => C4::Context::temporary_directory,    #temporary work directory
40
46
        transfer_date => dt_from_string(),
41
    my $self = {
42
        account        => $acct,
43
        schema         => $schema,
44
        file_transport => $file_transport,
45
        working_dir    => C4::Context::temporary_directory,    #temporary work directory
46
        transfer_date  => dt_from_string(),
47
    };
47
    };
48
48
49
    bless $self, $class;
49
    bless $self, $class;
Lines 62-389 sub download_messages { Link Here
62
    my ( $self, $message_type ) = @_;
62
    my ( $self, $message_type ) = @_;
63
    $self->{message_type} = $message_type;
63
    $self->{message_type} = $message_type;
64
64
65
    my @retrieved_files;
65
    unless ( $self->{file_transport} ) {
66
66
        carp "No file transport configured for EDI account " . $self->{account}->id;
67
    if ( $self->{account}->transport eq 'SFTP' ) {
67
        return;
68
        @retrieved_files = $self->sftp_download();
69
    } elsif ( $self->{account}->transport eq 'FILE' ) {
70
        @retrieved_files = $self->file_download();
71
    } else {    # assume FTP
72
        @retrieved_files = $self->ftp_download();
73
    }
68
    }
74
    return @retrieved_files;
75
}
76
77
sub upload_messages {
78
    my ( $self, @messages ) = @_;
79
    if (@messages) {
80
        if ( $self->{account}->transport eq 'SFTP' ) {
81
            $self->sftp_upload(@messages);
82
        } elsif ( $self->{account}->transport eq 'FILE' ) {
83
            $self->file_upload(@messages);
84
        } else {    # assume FTP
85
            $self->ftp_upload(@messages);
86
        }
87
    }
88
    return;
89
}
90
91
sub file_download {
92
    my $self = shift;
93
    my @downloaded_files;
94
69
95
    my $file_ext = _get_file_ext( $self->{message_type} );
70
    my $file_ext = _get_file_ext( $self->{message_type} );
96
97
    my $dir      = $self->{account}->download_directory;    # makes code more readable
98
                                                            # C = ready to retrieve E = Edifact
99
    my $msg_hash = $self->message_hash();
71
    my $msg_hash = $self->message_hash();
100
    if ( opendir my $dh, $dir ) {
72
    my @downloaded_files;
101
        my @file_list = readdir $dh;
102
        closedir $dh;
103
        foreach my $filename (@file_list) {
104
73
105
            if ( $filename =~ m/[.]$file_ext$/ ) {
74
    # Connect to the transport
106
                if ( copy( "$dir/$filename", $self->{working_dir} ) ) {
75
    unless ( $self->{file_transport}->connect() ) {
107
                } else {
76
        carp "Failed to connect to file transport: " . $self->{file_transport}->id;
108
                    carp "copy of $filename failed";
109
                    next;
110
                }
111
                push @downloaded_files, $filename;
112
                my $processed_name = $filename;
113
                substr $processed_name, -3, 1, 'E';
114
                move( "$dir/$filename", "$dir/$processed_name" );
115
            }
116
        }
117
        $self->ingest( $msg_hash, @downloaded_files );
118
    } else {
119
        carp "Cannot open $dir";
120
        return;
77
        return;
121
    }
78
    }
122
    return @downloaded_files;
123
}
124
79
125
sub sftp_download {
80
    # Change to download directory
126
    my $self = shift;
81
    my $download_dir = $self->{file_transport}->download_directory;
127
82
    if ( $download_dir && !$self->{file_transport}->change_directory($download_dir) ) {
128
    my $file_ext = _get_file_ext( $self->{message_type} );
83
        carp "Failed to change to download directory: $download_dir";
84
        return;
85
    }
129
86
130
    # C = ready to retrieve E = Edifact
87
    # Get file list
131
    my $msg_hash = $self->message_hash();
88
    my $file_list = $self->{file_transport}->list_files();
132
    my @downloaded_files;
89
    unless ($file_list) {
133
    my $port = $self->{account}->download_port ? $self->{account}->download_port : '22';
90
        carp "Failed to get file list from transport";
134
    my $sftp = Net::SFTP::Foreign->new(
91
        return;
135
        host     => $self->{account}->host,
136
        user     => $self->{account}->username,
137
        password => Koha::Encryption->new->decrypt_hex( $self->{account}->password ),
138
        port     => $port,
139
        timeout  => 10,
140
    );
141
    if ( $sftp->error ) {
142
        return $self->_abort_download(
143
            undef,
144
            'Unable to connect to remote host: ' . $sftp->error
145
        );
146
    }
92
    }
147
    $sftp->setcwd( $self->{account}->download_directory )
93
148
        or return $self->_abort_download(
94
    # Process files matching our criteria
149
        $sftp,
150
        "Cannot change remote dir: " . $sftp->error
151
        );
152
    my $file_list = $sftp->ls()
153
        or return $self->_abort_download(
154
        $sftp,
155
        "cannot get file list from server: " . $sftp->error
156
        );
157
    foreach my $file ( @{$file_list} ) {
95
    foreach my $file ( @{$file_list} ) {
158
        my $filename = $file->{filename};
96
        my $filename = $file->{filename};
159
97
160
        if ( $filename =~ m/[.]$file_ext$/ ) {
98
        if ( $filename =~ m/[.]$file_ext$/ ) {
161
            $sftp->get( $filename, "$self->{working_dir}/$filename" );
99
            my $local_file = "$self->{working_dir}/$filename";
162
            if ( $sftp->error ) {
163
                $self->_abort_download(
164
                    $sftp,
165
                    "Error retrieving $filename: " . $sftp->error
166
                );
167
                last;
168
            }
169
            push @downloaded_files, $filename;
170
            my $processed_name = $filename;
171
            substr $processed_name, -3, 1, 'E';
172
173
            #$sftp->atomic_rename( $filename, $processed_name );
174
            my $ret = $sftp->rename( $filename, $processed_name );
175
            if ( !$ret ) {
176
                $self->_abort_download(
177
                    $sftp,
178
                    "Error renaming $filename: " . $sftp->error
179
                );
180
                last;
181
            }
182
100
183
        }
101
            # Download the file
184
    }
102
            if ( $self->{file_transport}->download_file( $filename, $local_file ) ) {
185
    $sftp->disconnect;
103
                push @downloaded_files, $filename;
186
    $self->ingest( $msg_hash, @downloaded_files );
187
188
    return @downloaded_files;
189
}
190
191
sub ingest {
192
    my ( $self, $msg_hash, @downloaded_files ) = @_;
193
    foreach my $f (@downloaded_files) {
194
195
        # Check file has not been downloaded already
196
        my $existing_file = $self->{schema}->resultset('EdifactMessage')->find( { filename => $f, } );
197
        if ($existing_file) {
198
            carp "skipping ingest of $f : filename exists";
199
            next;
200
        }
201
202
        $msg_hash->{filename} = $f;
203
        my $file_content = read_file( "$self->{working_dir}/$f", binmode => ':raw' );
204
        if ( !defined $file_content ) {
205
            carp "Unable to read download file $f";
206
            next;
207
        }
208
        from_to( $file_content, 'iso-8859-1', 'utf8' );
209
        $msg_hash->{raw_msg} = $file_content;
210
        $self->{schema}->resultset('EdifactMessage')->create($msg_hash);
211
    }
212
    return;
213
}
214
215
sub ftp_download {
216
    my $self = shift;
217
218
    my $file_ext = _get_file_ext( $self->{message_type} );
219
220
    # C = ready to retrieve E = Edifact
221
222
    my $msg_hash = $self->message_hash();
223
    my @downloaded_files;
224
    my $port = $self->{account}->download_port ? $self->{account}->download_port : '21';
225
    my $ftp  = Net::FTP->new(
226
        $self->{account}->host,
227
        Port    => $port,
228
        Timeout => 10,
229
        Passive => 1
230
        )
231
        or return $self->_abort_download(
232
        undef,
233
        "Cannot connect to " . $self->{account}->host . ": $EVAL_ERROR"
234
        );
235
    $ftp->login( $self->{account}->username, Koha::Encryption->new->decrypt_hex( $self->{account}->password ) )
236
        or return $self->_abort_download( $ftp, "Cannot login: " . $ftp->message() );
237
    $ftp->cwd( $self->{account}->download_directory )
238
        or return $self->_abort_download(
239
        $ftp,
240
        "Cannot change remote dir : " . $ftp->message()
241
        );
242
    my $file_list = $ftp->ls()
243
        or return $self->_abort_download( $ftp, 'cannot get file list from server' );
244
245
    foreach my $filename ( @{$file_list} ) {
246
104
247
        if ( $filename =~ m/[.]$file_ext$/ ) {
105
                # Rename file on server to mark as processed (EDI-specific behavior)
106
                my $processed_name = $filename;
107
                substr $processed_name, -3, 1, 'E';
248
108
249
            if ( !$ftp->get( $filename, "$self->{working_dir}/$filename" ) ) {
109
                # Mark file as processed using the transport's rename functionality
250
                $self->_abort_download(
110
                $self->{file_transport}->rename_file( $filename, $processed_name );
251
                    $ftp,
111
            } else {
252
                    "Error retrieving $filename: " . $ftp->message
112
                carp "Failed to download file: $filename";
253
                );
254
                last;
255
            }
113
            }
256
257
            push @downloaded_files, $filename;
258
            my $processed_name = $filename;
259
            substr $processed_name, -3, 1, 'E';
260
            $ftp->rename( $filename, $processed_name );
261
        }
114
        }
262
    }
115
    }
263
    $ftp->quit;
264
116
117
    # Ingest downloaded files
265
    $self->ingest( $msg_hash, @downloaded_files );
118
    $self->ingest( $msg_hash, @downloaded_files );
266
119
120
    # Clean up connection
121
    $self->{file_transport}->disconnect();
122
267
    return @downloaded_files;
123
    return @downloaded_files;
268
}
124
}
269
125
270
sub ftp_upload {
126
sub upload_messages {
271
    my ( $self, @messages ) = @_;
127
    my ( $self, @messages ) = @_;
272
    my $port = $self->{account}->upload_port ? $self->{account}->upload_port : '21';
273
    my $ftp  = Net::FTP->new(
274
        $self->{account}->host,
275
        Port    => $port,
276
        Timeout => 10,
277
        Passive => 1
278
        )
279
        or return $self->_abort_download(
280
        undef,
281
        "Cannot connect to " . $self->{account}->host . ": $EVAL_ERROR"
282
        );
283
    $ftp->login( $self->{account}->username, Koha::Encryption->new->decrypt_hex( $self->{account}->password ) )
284
        or return $self->_abort_download( $ftp, "Cannot login: " . $ftp->message() );
285
    $ftp->cwd( $self->{account}->upload_directory )
286
        or return $self->_abort_download(
287
        $ftp,
288
        "Cannot change remote dir : " . $ftp->message()
289
        );
290
    foreach my $m (@messages) {
291
        my $content = $m->raw_msg;
292
        if ($content) {
293
            open my $fh, '<', \$content;
294
            if ( $ftp->put( $fh, $m->filename ) ) {
295
                close $fh;
296
                $m->transfer_date( $self->{transfer_date} );
297
                $m->status('sent');
298
                $m->update;
299
            } else {
300
128
301
                # error in transfer
129
    unless (@messages) {
130
        return;
131
    }
302
132
303
            }
133
    unless ( $self->{file_transport} ) {
304
        }
134
        carp "No file transport configured for EDI account " . $self->{account}->id;
135
        return;
305
    }
136
    }
306
137
307
    $ftp->quit;
138
    # Connect to the transport
308
    return;
139
    unless ( $self->{file_transport}->connect() ) {
309
}
140
        carp "Failed to connect to file transport: " . $self->{file_transport}->id;
141
        return;
142
    }
143
144
    # Change to upload directory
145
    my $upload_dir = $self->{file_transport}->upload_directory;
146
    if ( $upload_dir && !$self->{file_transport}->change_directory($upload_dir) ) {
147
        carp "Failed to change to upload directory: $upload_dir";
148
        return;
149
    }
310
150
311
sub sftp_upload {
312
    my ( $self, @messages ) = @_;
313
    my $port = $self->{account}->upload_port ? $self->{account}->upload_port : '22';
314
    my $sftp = Net::SFTP::Foreign->new(
315
        host     => $self->{account}->host,
316
        user     => $self->{account}->username,
317
        password => Koha::Encryption->new->decrypt_hex( $self->{account}->password ),
318
        port     => $port,
319
        timeout  => 10,
320
    );
321
    $sftp->die_on_error( "Cannot ssh to " . $self->{account}->host );
322
    $sftp->setcwd( $self->{account}->upload_directory )
323
        or return $self->_abort_download(
324
        $sftp,
325
        "Cannot change remote dir : " . $sftp->error
326
        );
327
    foreach my $m (@messages) {
151
    foreach my $m (@messages) {
328
        my $content = $m->raw_msg;
152
        my $content = $m->raw_msg;
329
        if ($content) {
153
        if ($content) {
330
            open my $fh, '<', \$content;
331
            if ( $sftp->put( $fh, $m->filename ) ) {
332
                close $fh;
333
                $m->transfer_date( $self->{transfer_date} );
334
                $m->status('sent');
335
                $m->update;
336
            } else {
337
154
338
                # error in transfer
155
            # Create temporary file for upload
156
            my $temp_file = "$self->{working_dir}/" . $m->filename;
339
157
340
            }
158
            if ( open my $fh, '>', $temp_file ) {
341
        }
159
                print {$fh} $content;
342
    }
160
                close $fh;
343
344
    # sftp will be closed on object destructor
345
    return;
346
}
347
161
348
sub file_upload {
162
                # Upload the file
349
    my ( $self, @messages ) = @_;
163
                if ( $self->{file_transport}->upload_file( $temp_file, $m->filename ) ) {
350
    my $dir = $self->{account}->upload_directory;
351
    if ( -d $dir ) {
352
        foreach my $m (@messages) {
353
            my $content = $m->raw_msg;
354
            if ($content) {
355
                my $filename     = $m->filename;
356
                my $new_filename = "$dir/$filename";
357
                if ( open my $fh, '>', $new_filename ) {
358
                    print {$fh} $content;
359
                    close $fh;
360
                    $m->transfer_date( $self->{transfer_date} );
164
                    $m->transfer_date( $self->{transfer_date} );
361
                    $m->status('sent');
165
                    $m->status('sent');
362
                    $m->update;
166
                    $m->update;
363
                } else {
167
                } else {
364
                    carp "Could not transfer " . $m->filename . " : $ERRNO";
168
                    carp "Failed to upload file: " . $m->filename;
365
                    next;
366
                }
169
                }
170
171
                # Clean up temp file
172
                unlink $temp_file;
173
            } else {
174
                carp "Could not create temporary file for upload: " . $m->filename;
367
            }
175
            }
368
        }
176
        }
369
    } else {
370
        carp "Upload directory $dir does not exist";
371
    }
177
    }
178
179
    # Clean up connection
180
    $self->{file_transport}->disconnect();
181
372
    return;
182
    return;
373
}
183
}
374
184
375
sub _abort_download {
185
sub ingest {
376
    my ( $self, $handle, $log_message ) = @_;
186
    my ( $self, $msg_hash, @downloaded_files ) = @_;
187
    foreach my $f (@downloaded_files) {
377
188
378
    my $a = $self->{account}->description;
189
        # Check file has not been downloaded already
190
        my $existing_file = $self->{schema}->resultset('EdifactMessage')->find( { filename => $f, } );
191
        if ($existing_file) {
192
            carp "skipping ingest of $f : filename exists";
193
            next;
194
        }
379
195
380
    if ($handle) {
196
        $msg_hash->{filename} = $f;
381
        $handle->abort();
197
        my $file_content = read_file( "$self->{working_dir}/$f", binmode => ':raw' );
198
        if ( !defined $file_content ) {
199
            carp "Unable to read download file $f";
200
            next;
201
        }
202
        from_to( $file_content, 'iso-8859-1', 'utf8' );
203
        $msg_hash->{raw_msg} = $file_content;
204
        $self->{schema}->resultset('EdifactMessage')->create($msg_hash);
382
    }
205
    }
383
    $log_message .= ": $a";
384
    carp $log_message;
385
386
    #returns undef i.e. an empty array
387
    return;
206
    return;
388
}
207
}
389
208
Lines 435-451 $downlowd->download_messages('QUOTE'); Link Here
435
254
436
=head1 DESCRIPTION
255
=head1 DESCRIPTION
437
256
438
Module that handles Edifact download and upload transport
257
Module that handles Edifact download and upload transport using the modern
439
currently can use sftp or ftp
258
Koha::File::Transport system. Supports SFTP, FTP, and local directory
440
Or FILE to access a local directory (useful for testing)
259
operations through a unified interface.
441
442
260
443
=head1 METHODS
261
=head1 METHODS
444
262
445
=head2 new
263
=head2 new
446
264
447
    Creates an object of Edifact::Transport requires to be passed the id
265
    Creates an object of Edifact::Transport requires to be passed the id
448
    identifying the relevant edi vendor account
266
    identifying the relevant edi vendor account. The account must have a
267
    file_transport_id configured to use the modern transport system.
449
268
450
=head2 working_directory
269
=head2 working_directory
451
270
Lines 454-510 Or FILE to access a local directory (useful for testing) Link Here
454
=head2 download_messages
273
=head2 download_messages
455
274
456
    called with the message type to download will perform the download
275
    called with the message type to download will perform the download
457
    using the appropriate transport method
276
    using the configured file transport
458
277
459
=head2 upload_messages
278
=head2 upload_messages
460
279
461
   passed an array of messages will upload them to the supplier site
280
   passed an array of messages will upload them to the supplier site
281
   using the configured file transport
462
282
463
=head2 file_download
464
465
Missing POD for file_download.
466
467
=head2 sftp_download
468
469
   called by download_messages to perform the download using SFTP
470
283
471
=head2 ingest
284
=head2 ingest
472
285
473
   loads downloaded files into the database
286
   loads downloaded files into the database
474
287
475
=head2 ftp_download
476
477
   called by download_messages to perform the download using FTP
478
479
=head2 ftp_upload
480
481
  called by upload_messages to perform the upload using ftp
482
483
=head2 sftp_upload
484
485
  called by upload_messages to perform the upload using sftp
486
487
=head2 file_upload
488
489
Missing POD for file_upload.
490
491
=head2 _abort_download
492
493
   internal routine to halt operation on error and supply a stacktrace
494
495
=head2 _get_file_ext
288
=head2 _get_file_ext
496
289
497
   internal method returning standard suffix for file names
290
   internal method returning standard suffix for file names
498
   according to message type
291
   according to message type
499
292
500
=head2 set_transport_direct
501
502
  sets the direct ingest flag so that the object reads files from
503
  the local file system useful in debugging
504
505
=head2 message_hash
293
=head2 message_hash
506
294
507
Missing POD for message_hash.
295
   creates the message hash structure for storing in the database
508
296
509
=head1 AUTHOR
297
=head1 AUTHOR
510
298
511
- 

Return to bug 38489