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