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

(-)a/Koha/Edifact/Transport.pm (-51 / +62 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
                                                            # C = ready to retrieve E = Edifact
114
    my $msg_hash = $self->message_hash();
114
    my $msg_hash = $self->message_hash();
115
    if ( opendir my $dh, $dir ) {
115
    if ( opendir my $dh, $dir ) {
116
        my @file_list = readdir $dh;
116
        my @file_list = readdir $dh;
Lines 119-126 sub file_download { Link Here
119
119
120
            if ( $filename =~ m/[.]$file_ext$/ ) {
120
            if ( $filename =~ m/[.]$file_ext$/ ) {
121
                if ( copy( "$dir/$filename", $self->{working_dir} ) ) {
121
                if ( copy( "$dir/$filename", $self->{working_dir} ) ) {
122
                }
122
                } else {
123
                else {
124
                    carp "copy of $filename failed";
123
                    carp "copy of $filename failed";
125
                    next;
124
                    next;
126
                }
125
                }
Lines 131-138 sub file_download { Link Here
131
            }
130
            }
132
        }
131
        }
133
        $self->ingest( $msg_hash, @downloaded_files );
132
        $self->ingest( $msg_hash, @downloaded_files );
134
    }
133
    } else {
135
    else {
136
        carp "Cannot open $dir";
134
        carp "Cannot open $dir";
137
        return;
135
        return;
138
    }
136
    }
Lines 162-184 sub sftp_download { Link Here
162
        timeout  => 10,
160
        timeout  => 10,
163
    );
161
    );
164
    if ( $sftp->error ) {
162
    if ( $sftp->error ) {
165
        return $self->_abort_download( undef,
163
        return $self->_abort_download(
166
            'Unable to connect to remote host: ' . $sftp->error );
164
            undef,
165
            'Unable to connect to remote host: ' . $sftp->error
166
        );
167
    }
167
    }
168
    $sftp->setcwd( $self->{account}->download_directory )
168
    $sftp->setcwd( $self->{account}->download_directory )
169
      or return $self->_abort_download( $sftp,
169
        or return $self->_abort_download(
170
        "Cannot change remote dir: " . $sftp->error );
170
        $sftp,
171
        "Cannot change remote dir: " . $sftp->error
172
        );
171
    my $file_list = $sftp->ls()
173
    my $file_list = $sftp->ls()
172
      or return $self->_abort_download( $sftp,
174
        or return $self->_abort_download(
173
        "cannot get file list from server: " . $sftp->error );
175
        $sftp,
176
        "cannot get file list from server: " . $sftp->error
177
        );
174
    foreach my $file ( @{$file_list} ) {
178
    foreach my $file ( @{$file_list} ) {
175
        my $filename = $file->{filename};
179
        my $filename = $file->{filename};
176
180
177
        if ( $filename =~ m/[.]$file_ext$/ ) {
181
        if ( $filename =~ m/[.]$file_ext$/ ) {
178
            $sftp->get( $filename, "$self->{working_dir}/$filename" );
182
            $sftp->get( $filename, "$self->{working_dir}/$filename" );
179
            if ( $sftp->error ) {
183
            if ( $sftp->error ) {
180
                $self->_abort_download( $sftp,
184
                $self->_abort_download(
181
                    "Error retrieving $filename: " . $sftp->error );
185
                    $sftp,
186
                    "Error retrieving $filename: " . $sftp->error
187
                );
182
                last;
188
                last;
183
            }
189
            }
184
            push @downloaded_files, $filename;
190
            push @downloaded_files, $filename;
Lines 188-195 sub sftp_download { Link Here
188
            #$sftp->atomic_rename( $filename, $processed_name );
194
            #$sftp->atomic_rename( $filename, $processed_name );
189
            my $ret = $sftp->rename( $filename, $processed_name );
195
            my $ret = $sftp->rename( $filename, $processed_name );
190
            if ( !$ret ) {
196
            if ( !$ret ) {
191
                $self->_abort_download( $sftp,
197
                $self->_abort_download(
192
                    "Error renaming $filename: " . $sftp->error );
198
                    $sftp,
199
                    "Error renaming $filename: " . $sftp->error
200
                );
193
                last;
201
                last;
194
            }
202
            }
195
203
Lines 206-221 sub ingest { Link Here
206
    foreach my $f (@downloaded_files) {
214
    foreach my $f (@downloaded_files) {
207
215
208
        # Check file has not been downloaded already
216
        # Check file has not been downloaded already
209
        my $existing_file = $self->{schema}->resultset('EdifactMessage')
217
        my $existing_file = $self->{schema}->resultset('EdifactMessage')->find( { filename => $f, } );
210
          ->find( { filename => $f, } );
211
        if ($existing_file) {
218
        if ($existing_file) {
212
            carp "skipping ingest of $f : filename exists";
219
            carp "skipping ingest of $f : filename exists";
213
            next;
220
            next;
214
        }
221
        }
215
222
216
        $msg_hash->{filename} = $f;
223
        $msg_hash->{filename} = $f;
217
        my $file_content =
224
        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 ) {
225
        if ( !defined $file_content ) {
220
            carp "Unable to read download file $f";
226
            carp "Unable to read download file $f";
221
            next;
227
            next;
Lines 243-249 sub ftp_download { Link Here
243
249
244
    my $msg_hash = $self->message_hash();
250
    my $msg_hash = $self->message_hash();
245
    my @downloaded_files;
251
    my @downloaded_files;
246
    my $ftp  = Net::FTP->new(
252
    my $ftp = Net::FTP->new(
247
        $sftp_server->host,
253
        $sftp_server->host,
248
        Port    => $sftp_server->port,
254
        Port    => $sftp_server->port,
249
        Timeout => 10,
255
        Timeout => 10,
Lines 254-274 sub ftp_download { Link Here
254
        "Cannot connect to " . $sftp_server->host . ": " . $EVAL_ERROR
260
        "Cannot connect to " . $sftp_server->host . ": " . $EVAL_ERROR
255
        );
261
        );
256
    $ftp->login( $sftp_server->user_name, $sftp_server->plain_text_password )
262
    $ftp->login( $sftp_server->user_name, $sftp_server->plain_text_password )
257
      or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" );
263
        or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" );
258
    $ftp->cwd( $self->{account}->download_directory )
264
    $ftp->cwd( $self->{account}->download_directory )
259
      or return $self->_abort_download( $ftp,
265
        or return $self->_abort_download(
260
        "Cannot change remote dir : $ftp->message()" );
266
        $ftp,
267
        "Cannot change remote dir : $ftp->message()"
268
        );
261
    my $file_list = $ftp->ls()
269
    my $file_list = $ftp->ls()
262
      or
270
        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
271
265
    foreach my $filename ( @{$file_list} ) {
272
    foreach my $filename ( @{$file_list} ) {
266
273
267
        if ( $filename =~ m/[.]$file_ext$/ ) {
274
        if ( $filename =~ m/[.]$file_ext$/ ) {
268
275
269
            if ( !$ftp->get( $filename, "$self->{working_dir}/$filename" ) ) {
276
            if ( !$ftp->get( $filename, "$self->{working_dir}/$filename" ) ) {
270
                $self->_abort_download( $ftp,
277
                $self->_abort_download(
271
                    "Error retrieving $filename: $ftp->message" );
278
                    $ftp,
279
                    "Error retrieving $filename: $ftp->message"
280
                );
272
                last;
281
                last;
273
            }
282
            }
274
283
Lines 295-301 sub ftp_upload { Link Here
295
    return
304
    return
296
        unless $sftp_server;
305
        unless $sftp_server;
297
306
298
    my $ftp  = Net::FTP->new(
307
    my $ftp = Net::FTP->new(
299
        $sftp_server->host,
308
        $sftp_server->host,
300
        Port    => $sftp_server->port,
309
        Port    => $sftp_server->port,
301
        Timeout => 10,
310
        Timeout => 10,
Lines 306-315 sub ftp_upload { Link Here
306
        "Cannot connect to " . $sftp_server->host . ": " . $EVAL_ERROR
315
        "Cannot connect to " . $sftp_server->host . ": " . $EVAL_ERROR
307
        );
316
        );
308
    $ftp->login( $sftp_server->user_name, $sftp_server->plain_text_password )
317
    $ftp->login( $sftp_server->user_name, $sftp_server->plain_text_password )
309
      or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" );
318
        or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" );
310
    $ftp->cwd( $self->{account}->upload_directory )
319
    $ftp->cwd( $self->{account}->upload_directory )
311
      or return $self->_abort_download( $ftp,
320
        or return $self->_abort_download(
312
        "Cannot change remote dir : $ftp->message()" );
321
        $ftp,
322
        "Cannot change remote dir : $ftp->message()"
323
        );
313
    foreach my $m (@messages) {
324
    foreach my $m (@messages) {
314
        my $content = $m->raw_msg;
325
        my $content = $m->raw_msg;
315
        if ($content) {
326
        if ($content) {
Lines 319-326 sub ftp_upload { Link Here
319
                $m->transfer_date( $self->{transfer_date} );
330
                $m->transfer_date( $self->{transfer_date} );
320
                $m->status('sent');
331
                $m->status('sent');
321
                $m->update;
332
                $m->update;
322
            }
333
            } else {
323
            else {
334
324
                # error in transfer
335
                # error in transfer
325
336
326
            }
337
            }
Lines 348-357 sub sftp_upload { Link Here
348
        port     => $sftp_server->port,
359
        port     => $sftp_server->port,
349
        timeout  => 10,
360
        timeout  => 10,
350
    );
361
    );
351
    $sftp->die_on_error("Cannot ssh to " . $sftp_server->host);
362
    $sftp->die_on_error( "Cannot ssh to " . $sftp_server->host );
352
    $sftp->setcwd( $self->{account}->upload_directory )
363
    $sftp->setcwd( $self->{account}->upload_directory )
353
      or return $self->_abort_download( $sftp,
364
        or return $self->_abort_download(
354
        "Cannot change remote dir : " . $sftp->error );
365
        $sftp,
366
        "Cannot change remote dir : " . $sftp->error
367
        );
355
    foreach my $m (@messages) {
368
    foreach my $m (@messages) {
356
        my $content = $m->raw_msg;
369
        my $content = $m->raw_msg;
357
        if ($content) {
370
        if ($content) {
Lines 361-368 sub sftp_upload { Link Here
361
                $m->transfer_date( $self->{transfer_date} );
374
                $m->transfer_date( $self->{transfer_date} );
362
                $m->status('sent');
375
                $m->status('sent');
363
                $m->update;
376
                $m->update;
364
            }
377
            } else {
365
            else {
378
366
                # error in transfer
379
                # error in transfer
367
380
368
            }
381
            }
Lines 388-402 sub file_upload { Link Here
388
                    $m->transfer_date( $self->{transfer_date} );
401
                    $m->transfer_date( $self->{transfer_date} );
389
                    $m->status('sent');
402
                    $m->status('sent');
390
                    $m->update;
403
                    $m->update;
391
                }
404
                } else {
392
                else {
393
                    carp "Could not transfer $m->filename : $ERRNO";
405
                    carp "Could not transfer $m->filename : $ERRNO";
394
                    next;
406
                    next;
395
                }
407
                }
396
            }
408
            }
397
        }
409
        }
398
    }
410
    } else {
399
    else {
400
        carp "Upload directory $dir does not exist";
411
        carp "Upload directory $dir does not exist";
401
    }
412
    }
402
    return;
413
    return;
(-)a/admin/edi_accounts.pl (-27 / +23 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
Lines 167-172 sub show_account { Link Here
167
164
168
    my $acct = $schema->resultset('VendorEdiAccount')->find($acct_id);
165
    my $acct = $schema->resultset('VendorEdiAccount')->find($acct_id);
169
    return unless $acct;
166
    return unless $acct;
170
    
167
171
    return $template->param( account => $acct );
168
    return $template->param( account => $acct );
172
}
169
}
173
- 

Return to bug 38489