Koha/Edifact/Transport.pm

   1 package Koha::Edifact::Transport;
   2
   3 # Copyright 2014,2015 PTFS-Europe Ltd
   4 #
   5 # This file is part of Koha.
   6 #
   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.
  11 #
  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.
  16 #
  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>.
  19
  20 use strict;
  21 use warnings;
  22 use utf8;
  23 use DateTime;
  24 use Carp;
  25 use English qw{ -no_match_vars };
  26 use Net::FTP;
  27 use Net::SFTP::Foreign;
  28 use File::Slurp;
  29 use File::Copy;
  30 use File::Basename qw( fileparse );
  31 use Koha::Database;
  32 use Encode qw( from_to );
  33
  34 sub new {
  35     my ( $class, $account_id ) = @_;
  36     my $database = Koha::Database->new();
  37     my $schema   = $database->schema();
  38     my $acct     = $schema->resultset('VendorEdiAccount')->find($account_id);
  39     my $self     = {
  40         account     => $acct,
  41         schema      => $schema,
  42         working_dir => C4::Context::temporary_directory,    #temporary work directory
  43         transfer_date => DateTime->now( time_zone => 'local' ),
  44     };
  45
  46     bless $self, $class;
  47     return $self;
  48 }
  49
  50 sub working_directory {
  51     my ( $self, $new_value ) = @_;
  52     if ($new_value) {
  53         $self->{working_dir} = $new_value;
  54     }
  55     return $self->{working_dir};
  56 }
  57
  58 sub download_messages {
  59     my ( $self, $message_type ) = @_;
  60     $self->{message_type} = $message_type;
  61
  62     my @retrieved_files;
  63
  64     if ( $self->{account}->transport eq 'SFTP' ) {
  65         @retrieved_files = $self->sftp_download();
  66     }
  67     elsif ( $self->{account}->transport eq 'FILE' ) {
  68         @retrieved_files = $self->file_download();
  69     }
  70     else {    # assume FTP
  71         @retrieved_files = $self->ftp_download();
  72     }
  73     return @retrieved_files;
  74 }
  75
  76 sub upload_messages {
  77     my ( $self, @messages ) = @_;
  78     if (@messages) {
  79         if ( $self->{account}->transport eq 'SFTP' ) {
  80             $self->sftp_upload(@messages);
  81         }
  82         elsif ( $self->{account}->transport eq 'FILE' ) {
  83             $self->file_upload(@messages);
  84         }
  85         else {    # assume FTP
  86             $self->ftp_upload(@messages);
  87         }
  88     }
  89     return;
  90 }
  91
  92 sub file_download {
  93     my $self = shift;
  94     my @downloaded_files;
  95
  96     my $file_ext = _get_file_ext( $self->{message_type} );
  97
  98     my $dir = $self->{account}->download_directory;   # makes code more readable
  99          # C = ready to retrieve E = Edifact
 100     my $msg_hash = $self->message_hash();
 101     if ( opendir my $dh, $dir ) {
 102         my @file_list = readdir $dh;
 103         closedir $dh;
 104         foreach my $filename (@file_list) {
 105
 106             if ( $filename =~ m/[.]$file_ext$/ ) {
 107                 if ( copy( "$dir/$filename", $self->{working_dir} ) ) {
 108                 }
 109                 else {
 110                     carp "copy of $filename failed";
 111                     next;
 112                 }
 113                 push @downloaded_files, $filename;
 114                 my $processed_name = $filename;
 115                 substr $processed_name, -3, 1, 'E';
 116                 move( "$dir/$filename", "$dir/$processed_name" );
 117             }
 118         }
 119         $self->ingest( $msg_hash, @downloaded_files );
 120     }
 121     else {
 122         carp "Cannot open $dir";
 123         return;
 124     }
 125     return @downloaded_files;
 126 }
 127
 128 sub sftp_download {
 129     my $self = shift;
 130
 131     my $file_ext = _get_file_ext( $self->{message_type} );
 132
 133     # C = ready to retrieve E = Edifact
 134     my $msg_hash = $self->message_hash();
 135     my @downloaded_files;
 136     my $sftp = Net::SFTP::Foreign->new(
 137         host     => $self->{account}->host,
 138         user     => $self->{account}->username,
 139         password => $self->{account}->password,
 140         timeout  => 10,
 141     );
 142     if ( $sftp->error ) {
 143         return $self->_abort_download( undef,
 144             'Unable to connect to remote host: ' . $sftp->error );
 145     }
 146     $sftp->setcwd( $self->{account}->download_directory )
 147       or return $self->_abort_download( $sftp,
 148         "Cannot change remote dir : $sftp->error" );
 149     my $file_list = $sftp->ls()
 150       or return $self->_abort_download( $sftp,
 151         "cannot get file list from server: $sftp->error" );
 152     foreach my $file ( @{$file_list} ) {
 153         my $filename = $file->{filename};
 154
 155         if ( $filename =~ m/[.]$file_ext$/ ) {
 156             $sftp->get( $filename, "$self->{working_dir}/$filename" );
 157             if ( $sftp->error ) {
 158                 $self->_abort_download( $sftp,
 159                     "Error retrieving $filename: $sftp->error" );
 160                 last;
 161             }
 162             push @downloaded_files, $filename;
 163             my $processed_name = $filename;
 164             substr $processed_name, -3, 1, 'E';
 165
 166             #$sftp->atomic_rename( $filename, $processed_name );
 167             my $ret = $sftp->rename( $filename, $processed_name );
 168             if ( !$ret ) {
 169                 $self->_abort_download( $sftp,
 170                     "Error renaming $filename: $sftp->error" );
 171                 last;
 172             }
 173
 174         }
 175     }
 176     $sftp->disconnect;
 177     $self->ingest( $msg_hash, @downloaded_files );
 178
 179     return @downloaded_files;
 180 }
 181
 182 sub ingest {
 183     my ( $self, $msg_hash, @downloaded_files ) = @_;
 184     foreach my $f (@downloaded_files) {
 185
 186         # Check file has not been downloaded already
 187         my $existing_file = $self->{schema}->resultset('EdifactMessage')
 188           ->find( { filename => $f, } );
 189         if ($existing_file) {
 190             carp "skipping ingest of $f : filename exists";
 191             next;
 192         }
 193
 194         $msg_hash->{filename} = $f;
 195         my $file_content =
 196           read_file( "$self->{working_dir}/$f", binmode => ':raw' );
 197         if ( !defined $file_content ) {
 198             carp "Unable to read download file $f";
 199             next;
 200         }
 201         from_to( $file_content, 'iso-8859-1', 'utf8' );
 202         $msg_hash->{raw_msg} = $file_content;
 203         $self->{schema}->resultset('EdifactMessage')->create($msg_hash);
 204     }
 205     return;
 206 }
 207
 208 sub ftp_download {
 209     my $self = shift;
 210
 211     my $file_ext = _get_file_ext( $self->{message_type} );
 212
 213     # C = ready to retrieve E = Edifact
 214
 215     my $msg_hash = $self->message_hash();
 216     my @downloaded_files;
 217     my $ftp = Net::FTP->new(
 218         $self->{account}->host,
 219         Timeout => 10,
 220         Passive => 1
 221       )
 222       or return $self->_abort_download( undef,
 223         "Cannot connect to $self->{account}->host: $EVAL_ERROR" );
 224     $ftp->login( $self->{account}->username, $self->{account}->password )
 225       or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" );
 226     $ftp->cwd( $self->{account}->download_directory )
 227       or return $self->_abort_download( $ftp,
 228         "Cannot change remote dir : $ftp->message()" );
 229     my $file_list = $ftp->ls()
 230       or
 231       return $self->_abort_download( $ftp, 'cannot get file list from server' );
 232
 233     foreach my $filename ( @{$file_list} ) {
 234
 235         if ( $filename =~ m/[.]$file_ext$/ ) {
 236
 237             if ( !$ftp->get( $filename, "$self->{working_dir}/$filename" ) ) {
 238                 $self->_abort_download( $ftp,
 239                     "Error retrieving $filename: $ftp->message" );
 240                 last;
 241             }
 242
 243             push @downloaded_files, $filename;
 244             my $processed_name = $filename;
 245             substr $processed_name, -3, 1, 'E';
 246             $ftp->rename( $filename, $processed_name );
 247         }
 248     }
 249     $ftp->quit;
 250
 251     $self->ingest( $msg_hash, @downloaded_files );
 252
 253     return @downloaded_files;
 254 }
 255
 256 sub ftp_upload {
 257     my ( $self, @messages ) = @_;
 258     my $ftp = Net::FTP->new(
 259         $self->{account}->host,
 260         Timeout => 10,
 261         Passive => 1
 262       )
 263       or return $self->_abort_download( undef,
 264         "Cannot connect to $self->{account}->host: $EVAL_ERROR" );
 265     $ftp->login( $self->{account}->username, $self->{account}->password )
 266       or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" );
 267     $ftp->cwd( $self->{account}->upload_directory )
 268       or return $self->_abort_download( $ftp,
 269         "Cannot change remote dir : $ftp->message()" );
 270     foreach my $m (@messages) {
 271         my $content = $m->raw_msg;
 272         if ($content) {
 273             open my $fh, '<', \$content;
 274             if ( $ftp->put( $fh, $m->filename ) ) {
 275                 close $fh;
 276                 $m->transfer_date( $self->{transfer_date} );
 277                 $m->status('sent');
 278                 $m->update;
 279             }
 280             else {
 281                 # error in transfer
 282
 283             }
 284         }
 285     }
 286
 287     $ftp->quit;
 288     return;
 289 }
 290
 291 sub sftp_upload {
 292     my ( $self, @messages ) = @_;
 293     my $sftp = Net::SFTP::Foreign->new(
 294         host     => $self->{account}->host,
 295         user     => $self->{account}->username,
 296         password => $self->{account}->password,
 297         timeout  => 10,
 298     );
 299     $sftp->die_on_error("Cannot ssh to $self->{account}->host");
 300     $sftp->setcwd( $self->{account}->upload_directory )
 301       or return $self->_abort_download( $sftp,
 302         "Cannot change remote dir : $sftp->error" );
 303     foreach my $m (@messages) {
 304         my $content = $m->raw_msg;
 305         if ($content) {
 306             open my $fh, '<', \$content;
 307             if ( $sftp->put( $fh, $m->filename ) ) {
 308                 close $fh;
 309                 $m->transfer_date( $self->{transfer_date} );
 310                 $m->status('sent');
 311                 $m->update;
 312             }
 313             else {
 314                 # error in transfer
 315
 316             }
 317         }
 318     }
 319
 320     # sftp will be closed on object destructor
 321     return;
 322 }
 323
 324 sub file_upload {
 325     my ( $self, @messages ) = @_;
 326     my $dir = $self->{account}->upload_directory;
 327     if ( -d $dir ) {
 328         foreach my $m (@messages) {
 329             my $content = $m->raw_msg;
 330             if ($content) {
 331                 my $filename     = $m->filename;
 332                 my $new_filename = "$dir/$filename";
 333                 if ( open my $fh, '>', $new_filename ) {
 334                     print {$fh} $content;
 335                     close $fh;
 336                     $m->transfer_date( $self->{transfer_date} );
 337                     $m->status('sent');
 338                     $m->update;
 339                 }
 340                 else {
 341                     carp "Could not transfer $m->filename : $ERRNO";
 342                     next;
 343                 }
 344             }
 345         }
 346     }
 347     else {
 348         carp "Upload directory $dir does not exist";
 349     }
 350     return;
 351 }
 352
 353 sub _abort_download {
 354     my ( $self, $handle, $log_message ) = @_;
 355
 356     my $a = $self->{account}->description;
 357
 358     if ($handle) {
 359         $handle->abort();
 360     }
 361     $log_message .= ": $a";
 362     carp $log_message;
 363
 364     #returns undef i.e. an empty array
 365     return;
 366 }
 367
 368 sub _get_file_ext {
 369     my $type = shift;
 370
 371     # Extension format
 372     # 1st char Status C = Ready For pickup A = Completed E = Extracted
 373     # 2nd Char Standard E = Edifact
 374     # 3rd Char Type of message
 375     my %file_types = (
 376         QUOTE   => 'CEQ',
 377         INVOICE => 'CEI',
 378         ORDRSP  => 'CEA',
 379         ALL     => 'CE.',
 380     );
 381     if ( exists $file_types{$type} ) {
 382         return $file_types{$type};
 383     }
 384     return 'XXXX';    # non matching type
 385 }
 386
 387 sub message_hash {
 388     my $self = shift;
 389     my $msg  = {
 390         message_type  => $self->{message_type},
 391         vendor_id     => $self->{account}->vendor_id,
 392         edi_acct      => $self->{account}->id,
 393         status        => 'new',
 394         deleted       => 0,
 395         transfer_date => $self->{transfer_date}->ymd(),
 396     };
 397
 398     return $msg;
 399 }
 400
 401 1;
 402 __END__
 403
 404 =head1 NAME
 405
 406 Koha::Edifact::Transport
 407
 408 =head1 SYNOPSIS
 409
 410 my $download = Koha::Edifact::Transport->new( $vendor_edi_account_id );
 411 $downlowd->download_messages('QUOTE');
 412
 413
 414 =head1 DESCRIPTION
 415
 416 Module that handles Edifact download and upload transport
 417 currently can use sftp or ftp
 418 Or FILE to access a local directory (useful for testing)
 419
 420
 421 =head1 METHODS
 422
 423 =head2 new
 424
 425     Creates an object of Edifact::Transport requires to be passed the id
 426     identifying the relevant edi vendor account
 427
 428 =head2 working_directory
 429
 430     getter and setter for the working_directory attribute
 431
 432 =head2 download_messages
 433
 434     called with the message type to download will perform the download
 435     using the appropriate transport method
 436
 437 =head2 upload_messages
 438
 439    passed an array of messages will upload them to the supplier site
 440
 441 =head2 sftp_download
 442
 443    called by download_messages to perform the download using SFTP
 444
 445 =head2 ingest
 446
 447    loads downloaded files into the database
 448
 449 =head2 ftp_download
 450
 451    called by download_messages to perform the download using FTP
 452
 453 =head2 ftp_upload
 454
 455   called by upload_messages to perform the upload using ftp
 456
 457 =head2 sftp_upload
 458
 459   called by upload_messages to perform the upload using sftp
 460
 461 =head2 _abort_download
 462
 463    internal routine to halt operation on error and supply a stacktrace
 464
 465 =head2 _get_file_ext
 466
 467    internal method returning standard suffix for file names
 468    according to message type
 469
 470 =head2 set_transport_direct
 471
 472   sets the direct ingest flag so that the object reads files from
 473   the local file system useful in debugging
 474
 475 =head1 AUTHOR
 476
 477    Colin Campbell <colin.campbell@ptfs-europe.com>
 478
 479
 480 =head1 COPYRIGHT
 481
 482    Copyright 2014,2015 PTFS-Europe Ltd
 483    This program is free software, You may redistribute it under
 484    under the terms of the GNU General Public License
 485
 486
 487 =cut