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