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

(-)a/Koha/Edifact/Transport.pm (-71 / +83 lines)
Lines 23-31 use utf8; Link Here
23
23
24
use Carp qw( carp );
24
use Carp qw( carp );
25
use DateTime;
25
use DateTime;
26
use Encode qw( from_to );
26
use Encode      qw( from_to );
27
use English qw{ -no_match_vars };
27
use English     qw{ -no_match_vars };
28
use File::Copy qw( copy move );
28
use File::Copy  qw( copy move );
29
use File::Slurp qw( read_file );
29
use File::Slurp qw( read_file );
30
use Net::FTP;
30
use Net::FTP;
31
use Net::SFTP::Foreign;
31
use Net::SFTP::Foreign;
Lines 40-48 sub new { Link Here
40
    my $schema   = $database->schema();
40
    my $schema   = $database->schema();
41
    my $acct     = $schema->resultset('VendorEdiAccount')->find($account_id);
41
    my $acct     = $schema->resultset('VendorEdiAccount')->find($account_id);
42
    my $self     = {
42
    my $self     = {
43
        account     => $acct,
43
        account       => $acct,
44
        schema      => $schema,
44
        schema        => $schema,
45
        working_dir => C4::Context::temporary_directory,    #temporary work directory
45
        working_dir   => C4::Context::temporary_directory,    #temporary work directory
46
        transfer_date => dt_from_string(),
46
        transfer_date => dt_from_string(),
47
    };
47
    };
48
48
Lines 65-71 sub download_messages { Link Here
65
    my $sftp_server_id = $self->{account}->download_sftp_server_id;
65
    my $sftp_server_id = $self->{account}->download_sftp_server_id;
66
    my $sftp_server_transport;
66
    my $sftp_server_transport;
67
    $sftp_server_transport = Koha::SFTP::Servers->find($sftp_server_id)->transport
67
    $sftp_server_transport = Koha::SFTP::Servers->find($sftp_server_id)->transport
68
        if ( $sftp_server_id );
68
        if ($sftp_server_id);
69
69
70
    my @retrieved_files;
70
    my @retrieved_files;
71
71
Lines 88-94 sub upload_messages { Link Here
88
    my $sftp_server_id = $self->{account}->upload_sftp_server_id;
88
    my $sftp_server_id = $self->{account}->upload_sftp_server_id;
89
    my $sftp_server_transport;
89
    my $sftp_server_transport;
90
    $sftp_server_transport = Koha::SFTP::Servers->find($sftp_server_id)->transport
90
    $sftp_server_transport = Koha::SFTP::Servers->find($sftp_server_id)->transport
91
        if ( $sftp_server_id );
91
        if ($sftp_server_id);
92
92
93
    if (@messages) {
93
    if (@messages) {
94
        if ( !$sftp_server_transport ) {
94
        if ( !$sftp_server_transport ) {
Lines 109-116 sub file_download { Link Here
109
109
110
    my $file_ext = _get_file_ext( $self->{message_type} );
110
    my $file_ext = _get_file_ext( $self->{message_type} );
111
111
112
    my $dir = $self->{account}->download_directory;   # makes code more readable
112
    my $dir = $self->{account}->download_directory;    # makes code more readable
113
         # C = ready to retrieve E = Edifact
113
114
    # C = ready to retrieve E = Edifact
114
    my $msg_hash = $self->message_hash();
115
    my $msg_hash = $self->message_hash();
115
    if ( opendir my $dh, $dir ) {
116
    if ( opendir my $dh, $dir ) {
116
        my @file_list = readdir $dh;
117
        my @file_list = readdir $dh;
Lines 119-126 sub file_download { Link Here
119
120
120
            if ( $filename =~ m/[.]$file_ext$/ ) {
121
            if ( $filename =~ m/[.]$file_ext$/ ) {
121
                if ( copy( "$dir/$filename", $self->{working_dir} ) ) {
122
                if ( copy( "$dir/$filename", $self->{working_dir} ) ) {
122
                }
123
                } else {
123
                else {
124
                    carp "copy of $filename failed";
124
                    carp "copy of $filename failed";
125
                    next;
125
                    next;
126
                }
126
                }
Lines 131-138 sub file_download { Link Here
131
            }
131
            }
132
        }
132
        }
133
        $self->ingest( $msg_hash, @downloaded_files );
133
        $self->ingest( $msg_hash, @downloaded_files );
134
    }
134
    } else {
135
    else {
136
        carp "Cannot open $dir";
135
        carp "Cannot open $dir";
137
        return;
136
        return;
138
    }
137
    }
Lines 162-184 sub sftp_download { Link Here
162
        timeout  => 10,
161
        timeout  => 10,
163
    );
162
    );
164
    if ( $sftp->error ) {
163
    if ( $sftp->error ) {
165
        return $self->_abort_download( undef,
164
        return $self->_abort_download(
166
            'Unable to connect to remote host: ' . $sftp->error );
165
            undef,
166
            'Unable to connect to remote host: ' . $sftp->error
167
        );
167
    }
168
    }
168
    $sftp->setcwd( $self->{account}->download_directory )
169
    $sftp->setcwd( $self->{account}->download_directory )
169
      or return $self->_abort_download( $sftp,
170
        or return $self->_abort_download(
170
        "Cannot change remote dir: " . $sftp->error );
171
        $sftp,
172
        "Cannot change remote dir: " . $sftp->error
173
        );
171
    my $file_list = $sftp->ls()
174
    my $file_list = $sftp->ls()
172
      or return $self->_abort_download( $sftp,
175
        or return $self->_abort_download(
173
        "cannot get file list from server: " . $sftp->error );
176
        $sftp,
177
        "cannot get file list from server: " . $sftp->error
178
        );
174
    foreach my $file ( @{$file_list} ) {
179
    foreach my $file ( @{$file_list} ) {
175
        my $filename = $file->{filename};
180
        my $filename = $file->{filename};
176
181
177
        if ( $filename =~ m/[.]$file_ext$/ ) {
182
        if ( $filename =~ m/[.]$file_ext$/ ) {
178
            $sftp->get( $filename, "$self->{working_dir}/$filename" );
183
            $sftp->get( $filename, "$self->{working_dir}/$filename" );
179
            if ( $sftp->error ) {
184
            if ( $sftp->error ) {
180
                $self->_abort_download( $sftp,
185
                $self->_abort_download(
181
                    "Error retrieving $filename: " . $sftp->error );
186
                    $sftp,
187
                    "Error retrieving $filename: " . $sftp->error
188
                );
182
                last;
189
                last;
183
            }
190
            }
184
            push @downloaded_files, $filename;
191
            push @downloaded_files, $filename;
Lines 188-195 sub sftp_download { Link Here
188
            #$sftp->atomic_rename( $filename, $processed_name );
195
            #$sftp->atomic_rename( $filename, $processed_name );
189
            my $ret = $sftp->rename( $filename, $processed_name );
196
            my $ret = $sftp->rename( $filename, $processed_name );
190
            if ( !$ret ) {
197
            if ( !$ret ) {
191
                $self->_abort_download( $sftp,
198
                $self->_abort_download(
192
                    "Error renaming $filename: " . $sftp->error );
199
                    $sftp,
200
                    "Error renaming $filename: " . $sftp->error
201
                );
193
                last;
202
                last;
194
            }
203
            }
195
204
Lines 206-221 sub ingest { Link Here
206
    foreach my $f (@downloaded_files) {
215
    foreach my $f (@downloaded_files) {
207
216
208
        # Check file has not been downloaded already
217
        # Check file has not been downloaded already
209
        my $existing_file = $self->{schema}->resultset('EdifactMessage')
218
        my $existing_file = $self->{schema}->resultset('EdifactMessage')->find( { filename => $f, } );
210
          ->find( { filename => $f, } );
211
        if ($existing_file) {
219
        if ($existing_file) {
212
            carp "skipping ingest of $f : filename exists";
220
            carp "skipping ingest of $f : filename exists";
213
            next;
221
            next;
214
        }
222
        }
215
223
216
        $msg_hash->{filename} = $f;
224
        $msg_hash->{filename} = $f;
217
        my $file_content =
225
        my $file_content = read_file( "$self->{working_dir}/$f", binmode => ':raw' );
218
          read_file( "$self->{working_dir}/$f", binmode => ':raw' );
219
        if ( !defined $file_content ) {
226
        if ( !defined $file_content ) {
220
            carp "Unable to read download file $f";
227
            carp "Unable to read download file $f";
221
            next;
228
            next;
Lines 243-249 sub ftp_download { Link Here
243
250
244
    my $msg_hash = $self->message_hash();
251
    my $msg_hash = $self->message_hash();
245
    my @downloaded_files;
252
    my @downloaded_files;
246
    my $ftp  = Net::FTP->new(
253
    my $ftp = Net::FTP->new(
247
        $sftp_server->host,
254
        $sftp_server->host,
248
        Port    => $sftp_server->port,
255
        Port    => $sftp_server->port,
249
        Timeout => 10,
256
        Timeout => 10,
Lines 254-274 sub ftp_download { Link Here
254
        "Cannot connect to " . $sftp_server->host . ": " . $EVAL_ERROR
261
        "Cannot connect to " . $sftp_server->host . ": " . $EVAL_ERROR
255
        );
262
        );
256
    $ftp->login( $sftp_server->user_name, $sftp_server->plain_text_password )
263
    $ftp->login( $sftp_server->user_name, $sftp_server->plain_text_password )
257
      or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" );
264
        or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" );
258
    $ftp->cwd( $self->{account}->download_directory )
265
    $ftp->cwd( $self->{account}->download_directory )
259
      or return $self->_abort_download( $ftp,
266
        or return $self->_abort_download(
260
        "Cannot change remote dir : $ftp->message()" );
267
        $ftp,
268
        "Cannot change remote dir : $ftp->message()"
269
        );
261
    my $file_list = $ftp->ls()
270
    my $file_list = $ftp->ls()
262
      or
271
        or return $self->_abort_download( $ftp, 'cannot get file list from server' );
263
      return $self->_abort_download( $ftp, 'cannot get file list from server' );
264
272
265
    foreach my $filename ( @{$file_list} ) {
273
    foreach my $filename ( @{$file_list} ) {
266
274
267
        if ( $filename =~ m/[.]$file_ext$/ ) {
275
        if ( $filename =~ m/[.]$file_ext$/ ) {
268
276
269
            if ( !$ftp->get( $filename, "$self->{working_dir}/$filename" ) ) {
277
            if ( !$ftp->get( $filename, "$self->{working_dir}/$filename" ) ) {
270
                $self->_abort_download( $ftp,
278
                $self->_abort_download(
271
                    "Error retrieving $filename: $ftp->message" );
279
                    $ftp,
280
                    "Error retrieving $filename: $ftp->message"
281
                );
272
                last;
282
                last;
273
            }
283
            }
274
284
Lines 295-301 sub ftp_upload { Link Here
295
    return
305
    return
296
        unless $sftp_server;
306
        unless $sftp_server;
297
307
298
    my $ftp  = Net::FTP->new(
308
    my $ftp = Net::FTP->new(
299
        $sftp_server->host,
309
        $sftp_server->host,
300
        Port    => $sftp_server->port,
310
        Port    => $sftp_server->port,
301
        Timeout => 10,
311
        Timeout => 10,
Lines 306-315 sub ftp_upload { Link Here
306
        "Cannot connect to " . $sftp_server->host . ": " . $EVAL_ERROR
316
        "Cannot connect to " . $sftp_server->host . ": " . $EVAL_ERROR
307
        );
317
        );
308
    $ftp->login( $sftp_server->user_name, $sftp_server->plain_text_password )
318
    $ftp->login( $sftp_server->user_name, $sftp_server->plain_text_password )
309
      or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" );
319
        or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" );
310
    $ftp->cwd( $self->{account}->upload_directory )
320
    $ftp->cwd( $self->{account}->upload_directory )
311
      or return $self->_abort_download( $ftp,
321
        or return $self->_abort_download(
312
        "Cannot change remote dir : $ftp->message()" );
322
        $ftp,
323
        "Cannot change remote dir : $ftp->message()"
324
        );
313
    foreach my $m (@messages) {
325
    foreach my $m (@messages) {
314
        my $content = $m->raw_msg;
326
        my $content = $m->raw_msg;
315
        if ($content) {
327
        if ($content) {
Lines 319-326 sub ftp_upload { Link Here
319
                $m->transfer_date( $self->{transfer_date} );
331
                $m->transfer_date( $self->{transfer_date} );
320
                $m->status('sent');
332
                $m->status('sent');
321
                $m->update;
333
                $m->update;
322
            }
334
            } else {
323
            else {
335
324
                # error in transfer
336
                # error in transfer
325
337
326
            }
338
            }
Lines 348-357 sub sftp_upload { Link Here
348
        port     => $sftp_server->port,
360
        port     => $sftp_server->port,
349
        timeout  => 10,
361
        timeout  => 10,
350
    );
362
    );
351
    $sftp->die_on_error("Cannot ssh to " . $sftp_server->host);
363
    $sftp->die_on_error( "Cannot ssh to " . $sftp_server->host );
352
    $sftp->setcwd( $self->{account}->upload_directory )
364
    $sftp->setcwd( $self->{account}->upload_directory )
353
      or return $self->_abort_download( $sftp,
365
        or return $self->_abort_download(
354
        "Cannot change remote dir : " . $sftp->error );
366
        $sftp,
367
        "Cannot change remote dir : " . $sftp->error
368
        );
355
    foreach my $m (@messages) {
369
    foreach my $m (@messages) {
356
        my $content = $m->raw_msg;
370
        my $content = $m->raw_msg;
357
        if ($content) {
371
        if ($content) {
Lines 361-368 sub sftp_upload { Link Here
361
                $m->transfer_date( $self->{transfer_date} );
375
                $m->transfer_date( $self->{transfer_date} );
362
                $m->status('sent');
376
                $m->status('sent');
363
                $m->update;
377
                $m->update;
364
            }
378
            } else {
365
            else {
379
366
                # error in transfer
380
                # error in transfer
367
381
368
            }
382
            }
Lines 388-402 sub file_upload { Link Here
388
                    $m->transfer_date( $self->{transfer_date} );
402
                    $m->transfer_date( $self->{transfer_date} );
389
                    $m->status('sent');
403
                    $m->status('sent');
390
                    $m->update;
404
                    $m->update;
391
                }
405
                } else {
392
                else {
393
                    carp "Could not transfer $m->filename : $ERRNO";
406
                    carp "Could not transfer $m->filename : $ERRNO";
394
                    next;
407
                    next;
395
                }
408
                }
396
            }
409
            }
397
        }
410
        }
398
    }
411
    } else {
399
    else {
400
        carp "Upload directory $dir does not exist";
412
        carp "Upload directory $dir does not exist";
401
    }
413
    }
402
    return;
414
    return;
Lines 474-539 Or FILE to access a local directory (useful for testing) Link Here
474
486
475
=head2 new
487
=head2 new
476
488
477
    Creates an object of Edifact::Transport requires to be passed the id
489
Creates an object of Edifact::Transport requires to be passed the id
478
    identifying the relevant edi vendor account
490
identifying the relevant edi vendor account
479
491
480
=head2 working_directory
492
=head2 working_directory
481
493
482
    getter and setter for the working_directory attribute
494
getter and setter for the working_directory attribute
483
495
484
=head2 download_messages
496
=head2 download_messages
485
497
486
    called with the message type to download will perform the download
498
called with the message type to download will perform the download
487
    using the appropriate transport method
499
using the appropriate transport method
488
500
489
=head2 upload_messages
501
=head2 upload_messages
490
502
491
   passed an array of messages will upload them to the supplier site
503
passed an array of messages will upload them to the supplier site
492
504
493
=head2 sftp_download
505
=head2 sftp_download
494
506
495
   called by download_messages to perform the download using SFTP
507
called by download_messages to perform the download using SFTP
496
508
497
=head2 ingest
509
=head2 ingest
498
510
499
   loads downloaded files into the database
511
loads downloaded files into the database
500
512
501
=head2 ftp_download
513
=head2 ftp_download
502
514
503
   called by download_messages to perform the download using FTP
515
called by download_messages to perform the download using FTP
504
516
505
=head2 ftp_upload
517
=head2 ftp_upload
506
518
507
  called by upload_messages to perform the upload using ftp
519
called by upload_messages to perform the upload using ftp
508
520
509
=head2 sftp_upload
521
=head2 sftp_upload
510
522
511
  called by upload_messages to perform the upload using sftp
523
called by upload_messages to perform the upload using sftp
512
524
513
=head2 _abort_download
525
=head2 _abort_download
514
526
515
   internal routine to halt operation on error and supply a stacktrace
527
internal routine to halt operation on error and supply a stacktrace
516
528
517
=head2 _get_file_ext
529
=head2 _get_file_ext
518
530
519
   internal method returning standard suffix for file names
531
internal method returning standard suffix for file names
520
   according to message type
532
according to message type
521
533
522
=head2 set_transport_direct
534
=head2 set_transport_direct
523
535
524
  sets the direct ingest flag so that the object reads files from
536
sets the direct ingest flag so that the object reads files from
525
  the local file system useful in debugging
537
the local file system useful in debugging
526
538
527
=head1 AUTHOR
539
=head1 AUTHOR
528
540
529
   Colin Campbell <colin.campbell@ptfs-europe.com>
541
Colin Campbell <colin.campbell@ptfs-europe.com>
530
542
531
543
532
=head1 COPYRIGHT
544
=head1 COPYRIGHT
533
545
534
   Copyright 2014,2015 PTFS-Europe Ltd
546
Copyright 2014,2015 PTFS-Europe Ltd
535
   This program is free software, You may redistribute it under
547
This program is free software, You may redistribute it under
536
   under the terms of the GNU General Public License
548
under the terms of the GNU General Public License
537
549
538
550
539
=cut
551
=cut
(-)a/admin/edi_accounts.pl (-26 / +22 lines)
Lines 21-40 use Modern::Perl; Link Here
21
21
22
use CGI;
22
use CGI;
23
23
24
use C4::Auth qw( get_template_and_user );
24
use C4::Auth   qw( get_template_and_user );
25
use C4::Output qw( output_html_with_http_headers );
25
use C4::Output qw( output_html_with_http_headers );
26
use Koha::Database;
26
use Koha::Database;
27
use Koha::Plugins;
27
use Koha::Plugins;
28
28
29
our $input = CGI->new();
29
our $input  = CGI->new();
30
our $schema = Koha::Database->new()->schema();
30
our $schema = Koha::Database->new()->schema();
31
31
32
our ( $template, $loggedinuser, $cookie ) = get_template_and_user(
32
our ( $template, $loggedinuser, $cookie ) = get_template_and_user(
33
    {
33
    {
34
        template_name   => 'admin/edi_accounts.tt',
34
        template_name => 'admin/edi_accounts.tt',
35
        query           => $input,
35
        query         => $input,
36
        type            => 'intranet',
36
        type          => 'intranet',
37
        flagsrequired   => { acquisition => 'edi_manage' },
37
        flagsrequired => { acquisition => 'edi_manage' },
38
    }
38
    }
39
);
39
);
40
40
Lines 47-53 if ( $op eq 'acct_form' ) { Link Here
47
    my @vendors = $schema->resultset('Aqbookseller')->search(
47
    my @vendors = $schema->resultset('Aqbookseller')->search(
48
        undef,
48
        undef,
49
        {
49
        {
50
            columns => [ 'name', 'id' ],
50
            columns  => [ 'name', 'id' ],
51
            order_by => { -asc => 'name' }
51
            order_by => { -asc => 'name' }
52
        }
52
        }
53
    );
53
    );
Lines 63-97 if ( $op eq 'acct_form' ) { Link Here
63
    $template->param( sftp_servers => \@sftp_servers );
63
    $template->param( sftp_servers => \@sftp_servers );
64
64
65
    if ( C4::Context->config("enable_plugins") ) {
65
    if ( C4::Context->config("enable_plugins") ) {
66
        my @plugins = Koha::Plugins->new()->GetPlugins({
66
        my @plugins = Koha::Plugins->new()->GetPlugins(
67
            method => 'edifact',
67
            {
68
        });
68
                method => 'edifact',
69
            }
70
        );
69
        $template->param( plugins => \@plugins );
71
        $template->param( plugins => \@plugins );
70
    }
72
    }
71
}
73
} elsif ( $op eq 'delete_confirm' ) {
72
elsif ( $op eq 'delete_confirm' ) {
73
    show_account();
74
    show_account();
74
    $template->param( delete_confirm => 1 );
75
    $template->param( delete_confirm => 1 );
75
}
76
} else {
76
else {
77
    if ( $op eq 'cud-save' ) {
77
    if ( $op eq 'cud-save' ) {
78
78
79
        # validate & display
79
        # validate & display
80
        my $id     = $input->param('id');
80
        my $id     = $input->param('id');
81
        my $fields = {
81
        my $fields = {
82
            description             => scalar $input->param('description'),
82
            description             => scalar $input->param('description'),
83
            upload_sftp_server_id   => $input->param('upload_sftp_server_id') || undef,
83
            upload_sftp_server_id   => $input->param('upload_sftp_server_id')   || undef,
84
            download_sftp_server_id => $input->param('download_sftp_server_id') || undef,
84
            download_sftp_server_id => $input->param('download_sftp_server_id') || undef,
85
            vendor_id               => scalar $input->param('vendor_id'),
85
            vendor_id               => scalar $input->param('vendor_id'),
86
            upload_directory        => scalar $input->param('upload_directory'),
86
            upload_directory        => scalar $input->param('upload_directory'),
87
            download_directory      => scalar $input->param('download_directory'),
87
            download_directory      => scalar $input->param('download_directory'),
88
            san                     => scalar $input->param('san'),
88
            san                     => scalar $input->param('san'),
89
            standard                => scalar $input->param('standard'),
89
            standard                => scalar $input->param('standard'),
90
            quotes_enabled          => $input->param('quotes_enabled') ? 1 : 0,
90
            quotes_enabled          => $input->param('quotes_enabled')    ? 1 : 0,
91
            invoices_enabled        => $input->param('invoices_enabled') ? 1 : 0,
91
            invoices_enabled        => $input->param('invoices_enabled')  ? 1 : 0,
92
            orders_enabled          => $input->param('orders_enabled') ? 1 : 0,
92
            orders_enabled          => $input->param('orders_enabled')    ? 1 : 0,
93
            responses_enabled       => $input->param('responses_enabled') ? 1 : 0,
93
            responses_enabled       => $input->param('responses_enabled') ? 1 : 0,
94
            auto_orders             => $input->param('auto_orders') ? 1 : 0,
94
            auto_orders             => $input->param('auto_orders')       ? 1 : 0,
95
            id_code_qualifier       => scalar $input->param('id_code_qualifier'),
95
            id_code_qualifier       => scalar $input->param('id_code_qualifier'),
96
            plugin                  => scalar $input->param('plugin'),
96
            plugin                  => scalar $input->param('plugin'),
97
        };
97
        };
Lines 102-116 else { Link Here
102
                    id => $id,
102
                    id => $id,
103
                }
103
                }
104
            )->update_all($fields);
104
            )->update_all($fields);
105
        }
105
        } else {    # new record
106
        else {    # new record
107
            $schema->resultset('VendorEdiAccount')->create($fields);
106
            $schema->resultset('VendorEdiAccount')->create($fields);
108
        }
107
        }
109
    }
108
    } elsif ( $op eq 'cud-delete_confirmed' ) {
110
    elsif ( $op eq 'cud-delete_confirmed' ) {
111
109
112
        $schema->resultset('VendorEdiAccount')
110
        $schema->resultset('VendorEdiAccount')->search( { id => scalar $input->param('id'), } )->delete_all;
113
          ->search( { id => scalar $input->param('id'), } )->delete_all;
114
    }
111
    }
115
112
116
    # we do a default dispaly after deletes and saves
113
    # we do a default dispaly after deletes and saves
117
- 

Return to bug 38489