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