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 |