|
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 |