1 package Koha::Edifact::Transport;
3 # Copyright 2014,2015 PTFS-Europe Ltd
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
26 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 );
31 use Net::SFTP::Foreign;
34 use Koha::DateUtils qw( dt_from_string );
38 my ( $class, $account_id ) = @_;
39 my $database = Koha::Database->new();
40 my $schema = $database->schema();
41 my $acct = $schema->resultset('VendorEdiAccount')->find($account_id);
45 working_dir => C4::Context::temporary_directory, #temporary work directory
46 transfer_date => dt_from_string(),
53 sub working_directory {
54 my ( $self, $new_value ) = @_;
56 $self->{working_dir} = $new_value;
58 return $self->{working_dir};
61 sub download_messages {
62 my ( $self, $message_type ) = @_;
63 $self->{message_type} = $message_type;
67 if ( $self->{account}->transport eq 'SFTP' ) {
68 @retrieved_files = $self->sftp_download();
70 elsif ( $self->{account}->transport eq 'FILE' ) {
71 @retrieved_files = $self->file_download();
74 @retrieved_files = $self->ftp_download();
76 return @retrieved_files;
80 my ( $self, @messages ) = @_;
82 if ( $self->{account}->transport eq 'SFTP' ) {
83 $self->sftp_upload(@messages);
85 elsif ( $self->{account}->transport eq 'FILE' ) {
86 $self->file_upload(@messages);
89 $self->ftp_upload(@messages);
99 my $file_ext = _get_file_ext( $self->{message_type} );
101 my $dir = $self->{account}->download_directory; # makes code more readable
102 # C = ready to retrieve E = Edifact
103 my $msg_hash = $self->message_hash();
104 if ( opendir my $dh, $dir ) {
105 my @file_list = readdir $dh;
107 foreach my $filename (@file_list) {
109 if ( $filename =~ m/[.]$file_ext$/ ) {
110 if ( copy( "$dir/$filename", $self->{working_dir} ) ) {
113 carp "copy of $filename failed";
116 push @downloaded_files, $filename;
117 my $processed_name = $filename;
118 substr $processed_name, -3, 1, 'E';
119 move( "$dir/$filename", "$dir/$processed_name" );
122 $self->ingest( $msg_hash, @downloaded_files );
125 carp "Cannot open $dir";
128 return @downloaded_files;
134 my $file_ext = _get_file_ext( $self->{message_type} );
136 # C = ready to retrieve E = Edifact
137 my $msg_hash = $self->message_hash();
138 my @downloaded_files;
139 my $sftp = Net::SFTP::Foreign->new(
140 host => $self->{account}->host,
141 user => $self->{account}->username,
142 password => Koha::Encryption->new->decrypt_hex($self->{account}->password),
145 if ( $sftp->error ) {
146 return $self->_abort_download( undef,
147 'Unable to connect to remote host: ' . $sftp->error );
149 $sftp->setcwd( $self->{account}->download_directory )
150 or return $self->_abort_download( $sftp,
151 "Cannot change remote dir : $sftp->error" );
152 my $file_list = $sftp->ls()
153 or return $self->_abort_download( $sftp,
154 "cannot get file list from server: $sftp->error" );
155 foreach my $file ( @{$file_list} ) {
156 my $filename = $file->{filename};
158 if ( $filename =~ m/[.]$file_ext$/ ) {
159 $sftp->get( $filename, "$self->{working_dir}/$filename" );
160 if ( $sftp->error ) {
161 $self->_abort_download( $sftp,
162 "Error retrieving $filename: $sftp->error" );
165 push @downloaded_files, $filename;
166 my $processed_name = $filename;
167 substr $processed_name, -3, 1, 'E';
169 #$sftp->atomic_rename( $filename, $processed_name );
170 my $ret = $sftp->rename( $filename, $processed_name );
172 $self->_abort_download( $sftp,
173 "Error renaming $filename: $sftp->error" );
180 $self->ingest( $msg_hash, @downloaded_files );
182 return @downloaded_files;
186 my ( $self, $msg_hash, @downloaded_files ) = @_;
187 foreach my $f (@downloaded_files) {
189 # Check file has not been downloaded already
190 my $existing_file = $self->{schema}->resultset('EdifactMessage')
191 ->find( { filename => $f, } );
192 if ($existing_file) {
193 carp "skipping ingest of $f : filename exists";
197 $msg_hash->{filename} = $f;
199 read_file( "$self->{working_dir}/$f", binmode => ':raw' );
200 if ( !defined $file_content ) {
201 carp "Unable to read download file $f";
204 from_to( $file_content, 'iso-8859-1', 'utf8' );
205 $msg_hash->{raw_msg} = $file_content;
206 $self->{schema}->resultset('EdifactMessage')->create($msg_hash);
214 my $file_ext = _get_file_ext( $self->{message_type} );
216 # C = ready to retrieve E = Edifact
218 my $msg_hash = $self->message_hash();
219 my @downloaded_files;
220 my $ftp = Net::FTP->new(
221 $self->{account}->host,
225 or return $self->_abort_download( undef,
226 "Cannot connect to $self->{account}->host: $EVAL_ERROR" );
227 $ftp->login( $self->{account}->username, Koha::Encryption->new->decrypt_hex($self->{account}->password) )
228 or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" );
229 $ftp->cwd( $self->{account}->download_directory )
230 or return $self->_abort_download( $ftp,
231 "Cannot change remote dir : $ftp->message()" );
232 my $file_list = $ftp->ls()
234 return $self->_abort_download( $ftp, 'cannot get file list from server' );
236 foreach my $filename ( @{$file_list} ) {
238 if ( $filename =~ m/[.]$file_ext$/ ) {
240 if ( !$ftp->get( $filename, "$self->{working_dir}/$filename" ) ) {
241 $self->_abort_download( $ftp,
242 "Error retrieving $filename: $ftp->message" );
246 push @downloaded_files, $filename;
247 my $processed_name = $filename;
248 substr $processed_name, -3, 1, 'E';
249 $ftp->rename( $filename, $processed_name );
254 $self->ingest( $msg_hash, @downloaded_files );
256 return @downloaded_files;
260 my ( $self, @messages ) = @_;
261 my $ftp = Net::FTP->new(
262 $self->{account}->host,
266 or return $self->_abort_download( undef,
267 "Cannot connect to $self->{account}->host: $EVAL_ERROR" );
268 $ftp->login( $self->{account}->username, Koha::Encryption->new->decrypt_hex($self->{account}->password) )
269 or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" );
270 $ftp->cwd( $self->{account}->upload_directory )
271 or return $self->_abort_download( $ftp,
272 "Cannot change remote dir : $ftp->message()" );
273 foreach my $m (@messages) {
274 my $content = $m->raw_msg;
276 open my $fh, '<', \$content;
277 if ( $ftp->put( $fh, $m->filename ) ) {
279 $m->transfer_date( $self->{transfer_date} );
295 my ( $self, @messages ) = @_;
296 my $sftp = Net::SFTP::Foreign->new(
297 host => $self->{account}->host,
298 user => $self->{account}->username,
299 password => Koha::Encryption->new->decrypt_hex($self->{account}->password),
302 $sftp->die_on_error("Cannot ssh to $self->{account}->host");
303 $sftp->setcwd( $self->{account}->upload_directory )
304 or return $self->_abort_download( $sftp,
305 "Cannot change remote dir : $sftp->error" );
306 foreach my $m (@messages) {
307 my $content = $m->raw_msg;
309 open my $fh, '<', \$content;
310 if ( $sftp->put( $fh, $m->filename ) ) {
312 $m->transfer_date( $self->{transfer_date} );
323 # sftp will be closed on object destructor
328 my ( $self, @messages ) = @_;
329 my $dir = $self->{account}->upload_directory;
331 foreach my $m (@messages) {
332 my $content = $m->raw_msg;
334 my $filename = $m->filename;
335 my $new_filename = "$dir/$filename";
336 if ( open my $fh, '>', $new_filename ) {
337 print {$fh} $content;
339 $m->transfer_date( $self->{transfer_date} );
344 carp "Could not transfer $m->filename : $ERRNO";
351 carp "Upload directory $dir does not exist";
356 sub _abort_download {
357 my ( $self, $handle, $log_message ) = @_;
359 my $a = $self->{account}->description;
364 $log_message .= ": $a";
367 #returns undef i.e. an empty array
375 # 1st char Status C = Ready For pickup A = Completed E = Extracted
376 # 2nd Char Standard E = Edifact
377 # 3rd Char Type of message
384 if ( exists $file_types{$type} ) {
385 return $file_types{$type};
387 return 'XXXX'; # non matching type
393 message_type => $self->{message_type},
394 vendor_id => $self->{account}->vendor_id,
395 edi_acct => $self->{account}->id,
398 transfer_date => $self->{transfer_date}->ymd(),
409 Koha::Edifact::Transport
413 my $download = Koha::Edifact::Transport->new( $vendor_edi_account_id );
414 $downlowd->download_messages('QUOTE');
419 Module that handles Edifact download and upload transport
420 currently can use sftp or ftp
421 Or FILE to access a local directory (useful for testing)
428 Creates an object of Edifact::Transport requires to be passed the id
429 identifying the relevant edi vendor account
431 =head2 working_directory
433 getter and setter for the working_directory attribute
435 =head2 download_messages
437 called with the message type to download will perform the download
438 using the appropriate transport method
440 =head2 upload_messages
442 passed an array of messages will upload them to the supplier site
446 called by download_messages to perform the download using SFTP
450 loads downloaded files into the database
454 called by download_messages to perform the download using FTP
458 called by upload_messages to perform the upload using ftp
462 called by upload_messages to perform the upload using sftp
464 =head2 _abort_download
466 internal routine to halt operation on error and supply a stacktrace
470 internal method returning standard suffix for file names
471 according to message type
473 =head2 set_transport_direct
475 sets the direct ingest flag so that the object reads files from
476 the local file system useful in debugging
480 Colin Campbell <colin.campbell@ptfs-europe.com>
485 Copyright 2014,2015 PTFS-Europe Ltd
486 This program is free software, You may redistribute it under
487 under the terms of the GNU General Public License