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_directory} = $new_value;
  54     }
  55     return $self->{working_directory};
  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         $msg_hash->{filename} = $f;
 186         my $file_content =
 187           read_file( "$self->{working_dir}/$f", binmode => ':raw' );
 188         if ( !defined $file_content ) {
 189             carp "Unable to read download file $f";
 190             next;
 191         }
 192         from_to( $file_content, 'iso-8859-1', 'utf8' );
 193         $msg_hash->{raw_msg} = $file_content;
 194         $self->{schema}->resultset('EdifactMessage')->create($msg_hash);
 195     }
 196     return;
 197 }
 198
 199 sub ftp_download {
 200     my $self = shift;
 201
 202     my $file_ext = _get_file_ext( $self->{message_type} );
 203
 204     # C = ready to retrieve E = Edifact
 205
 206     my $msg_hash = $self->message_hash();
 207     my @downloaded_files;
 208     my $ftp = Net::FTP->new(
 209         $self->{account}->host,
 210         Timeout => 10,
 211         Passive => 1
 212       )
 213       or return $self->_abort_download( undef,
 214         "Cannot connect to $self->{account}->host: $EVAL_ERROR" );
 215     $ftp->login( $self->{account}->username, $self->{account}->password )
 216       or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" );
 217     $ftp->cwd( $self->{account}->download_directory )
 218       or return $self->_abort_download( $ftp,
 219         "Cannot change remote dir : $ftp->message()" );
 220     my $file_list = $ftp->ls()
 221       or
 222       return $self->_abort_download( $ftp, 'cannot get file list from server' );
 223
 224     foreach my $filename ( @{$file_list} ) {
 225
 226         if ( $filename =~ m/[.]$file_ext$/ ) {
 227
 228             if ( !$ftp->get( $filename, "$self->{working_dir}/$filename" ) ) {
 229                 $self->_abort_download( $ftp,
 230                     "Error retrieving $filename: $ftp->message" );
 231                 last;
 232             }
 233
 234             push @downloaded_files, $filename;
 235             my $processed_name = $filename;
 236             substr $processed_name, -3, 1, 'E';
 237             $ftp->rename( $filename, $processed_name );
 238         }
 239     }
 240     $ftp->quit;
 241
 242     $self->ingest( $msg_hash, @downloaded_files );
 243
 244     return @downloaded_files;
 245 }
 246
 247 sub ftp_upload {
 248     my ( $self, @messages ) = @_;
 249     my $ftp = Net::FTP->new(
 250         $self->{account}->host,
 251         Timeout => 10,
 252         Passive => 1
 253       )
 254       or return $self->_abort_download( undef,
 255         "Cannot connect to $self->{account}->host: $EVAL_ERROR" );
 256     $ftp->login( $self->{account}->username, $self->{account}->password )
 257       or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" );
 258     $ftp->cwd( $self->{account}->upload_directory )
 259       or return $self->_abort_download( $ftp,
 260         "Cannot change remote dir : $ftp->message()" );
 261     foreach my $m (@messages) {
 262         my $content = $m->raw_msg;
 263         if ($content) {
 264             open my $fh, '<', \$content;
 265             if ( $ftp->put( $fh, $m->filename ) ) {
 266                 close $fh;
 267                 $m->transfer_date( $self->{transfer_date} );
 268                 $m->status('sent');
 269                 $m->update;
 270             }
 271             else {
 272                 # error in transfer
 273
 274             }
 275         }
 276     }
 277
 278     $ftp->quit;
 279     return;
 280 }
 281
 282 sub sftp_upload {
 283     my ( $self, @messages ) = @_;
 284     my $sftp = Net::SFTP::Foreign->new(
 285         host     => $self->{account}->host,
 286         user     => $self->{account}->username,
 287         password => $self->{account}->password,
 288         timeout  => 10,
 289     );
 290     $sftp->die_on_error("Cannot ssh to $self->{account}->host");
 291     $sftp->setcwd( $self->{account}->upload_directory )
 292       or return $self->_abort_download( $sftp,
 293         "Cannot change remote dir : $sftp->error" );
 294     foreach my $m (@messages) {
 295         my $content = $m->raw_msg;
 296         if ($content) {
 297             open my $fh, '<', \$content;
 298             if ( $sftp->put( $fh, $m->filename ) ) {
 299                 close $fh;
 300                 $m->transfer_date( $self->{transfer_date} );
 301                 $m->status('sent');
 302                 $m->update;
 303             }
 304             else {
 305                 # error in transfer
 306
 307             }
 308         }
 309     }
 310
 311     # sftp will be closed on object destructor
 312     return;
 313 }
 314
 315 sub file_upload {
 316     my ( $self, @messages ) = @_;
 317     my $dir = $self->{account}->upload_directory;
 318     if ( -d $dir ) {
 319         foreach my $m (@messages) {
 320             my $content = $m->raw_msg;
 321             if ($content) {
 322                 my $filename     = $m->filename;
 323                 my $new_filename = "$dir/$filename";
 324                 if ( open my $fh, '>', $new_filename ) {
 325                     print {$fh} $content;
 326                     close $fh;
 327                     $m->transfer_date( $self->{transfer_date} );
 328                     $m->status('sent');
 329                     $m->update;
 330                 }
 331                 else {
 332                     carp "Could not transfer $m->filename : $ERRNO";
 333                     next;
 334                 }
 335             }
 336         }
 337     }
 338     else {
 339         carp "Upload directory $dir does not exist";
 340     }
 341     return;
 342 }
 343
 344 sub _abort_download {
 345     my ( $self, $handle, $log_message ) = @_;
 346
 347     my $a = $self->{account}->description;
 348
 349     if ($handle) {
 350         $handle->abort();
 351     }
 352     $log_message .= ": $a";
 353     carp $log_message;
 354
 355     #returns undef i.e. an empty array
 356     return;
 357 }
 358
 359 sub _get_file_ext {
 360     my $type = shift;
 361
 362     # Extension format
 363     # 1st char Status C = Ready For pickup A = Completed E = Extracted
 364     # 2nd Char Standard E = Edifact
 365     # 3rd Char Type of message
 366     my %file_types = (
 367         QUOTE   => 'CEQ',
 368         INVOICE => 'CEI',
 369         ORDRSP  => 'CEA',
 370         ALL     => 'CE.',
 371     );
 372     if ( exists $file_types{$type} ) {
 373         return $file_types{$type};
 374     }
 375     return 'XXXX';    # non matching type
 376 }
 377
 378 sub message_hash {
 379     my $self = shift;
 380     my $msg  = {
 381         message_type  => $self->{message_type},
 382         vendor_id     => $self->{account}->vendor_id,
 383         edi_acct      => $self->{account}->id,
 384         status        => 'new',
 385         deleted       => 0,
 386         transfer_date => $self->{transfer_date}->ymd(),
 387     };
 388
 389     return $msg;
 390 }
 391
 392 1;
 393 __END__
 394
 395 =head1 NAME
 396
 397 Koha::Edifact::Transport
 398
 399 =head1 SYNOPSIS
 400
 401 my $download = Koha::Edifact::Transport->new( $vendor_edi_account_id );
 402 $downlowd->download_messages('QUOTE');
 403
 404
 405 =head1 DESCRIPTION
 406
 407 Module that handles Edifact download and upload transport
 408 currently can use sftp or ftp
 409 Or FILE to access a local directory (useful for testing)
 410
 411
 412 =head1 METHODS
 413
 414 =head2 new
 415
 416     Creates an object of Edifact::Transport requires to be passed the id
 417     identifying the relevant edi vendor account
 418
 419 =head2 working_directory
 420
 421     getter and setter for the working_directory attribute
 422
 423 =head2 download_messages
 424
 425     called with the message type to download will perform the download
 426     using the appropriate transport method
 427
 428 =head2 upload_messages
 429
 430    passed an array of messages will upload them to the supplier site
 431
 432 =head2 sftp_download
 433
 434    called by download_messages to perform the download using SFTP
 435
 436 =head2 ingest
 437
 438    loads downloaded files into the database
 439
 440 =head2 ftp_download
 441
 442    called by download_messages to perform the download using FTP
 443
 444 =head2 ftp_upload
 445
 446   called by upload_messages to perform the upload using ftp
 447
 448 =head2 sftp_upload
 449
 450   called by upload_messages to perform the upload using sftp
 451
 452 =head2 _abort_download
 453
 454    internal routine to halt operation on error and supply a stacktrace
 455
 456 =head2 _get_file_ext
 457
 458    internal method returning standard suffix for file names
 459    according to message type
 460
 461 =head2 set_transport_direct
 462
 463   sets the direct ingest flag so that the object reads files from
 464   the local file system useful in debugging
 465
 466 =head1 AUTHOR
 467
 468    Colin Campbell <colin.campbell@ptfs-europe.com>
 469
 470
 471 =head1 COPYRIGHT
 472
 473    Copyright 2014,2015 PTFS-Europe Ltd
 474    This program is free software, You may redistribute it under
 475    under the terms of the GNU General Public License
 476
 477
 478 =cut