Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm

   1 package OpenILS::Application::Acq::EDI;
   2 use base qw/OpenILS::Application/;
   3
   4 use strict; use warnings;
   5
   6 use IO::Scalar;
   7
   8 use OpenSRF::AppSession;
   9 use OpenSRF::EX qw/:try/;
  10 use OpenSRF::Utils::Logger qw(:logger);
  11 use OpenSRF::Utils::JSON;
  12
  13 use OpenILS::Utils::RemoteAccount;
  14 use OpenILS::Utils::CStoreEditor q/new_editor/;
  15 use OpenILS::Utils::Fieldmapper;
  16 use OpenILS::Application::Acq::EDI::Translator;
  17
  18 use Data::Dumper;
  19 our $verbose = 0;
  20
  21 sub new {
  22     my($class, %args) = @_;
  23     my $self = bless(\%args, $class);
  24     # $self->{args} = {};
  25     return $self;
  26 }
  27
  28 our $translator;
  29
  30 sub translator {
  31     return $translator ||= OpenILS::Application::Acq::EDI::Translator->new(@_);
  32 }
  33
  34 my %map = (
  35     host     => 'remote_host',
  36     username => 'remote_user',
  37     password => 'remote_password',
  38     account  => 'remote_account',
  39     # in_dir   => 'remote_path',   # field_map overrides path with in_dir
  40     path     => 'remote_path',
  41 );
  42
  43
  44 ## Just for debugging stuff:
  45 sub add_a_msg {
  46     my ($self, $conn) = @_;
  47     my $e = new_editor(xact=>1);
  48     my $incoming = Fieldmapper::acq::edi_message->new;
  49     $incoming->edi("This is content");
  50     $incoming->account(1);
  51     $incoming->remote_file('in/some_file.edi');
  52     $e->create_acq_edi_message($incoming);;
  53     $e->commit;
  54 }
  55 # __PACKAGE__->register_method( method => 'add_a_msg', api_name => 'open-ils.acq.edi.add_a_msg');  # debugging
  56
  57 __PACKAGE__->register_method(
  58         method    => 'retrieve',
  59         api_name  => 'open-ils.acq.edi.retrieve',
  60         signature => {
  61         desc   => 'Fetch incoming message(s) from EDI accounts.  ' .
  62                   'Optional arguments to restrict to one vendor and/or a max number of messages.  ' .
  63                   'Note that messages are not parsed or processed here, just fetched and translated.',
  64         params => [
  65             {desc => 'Authentication token',        type => 'string'},
  66             {desc => 'Vendor ID (undef for "all")', type => 'number'},
  67             {desc => 'Date Inactive Since',         type => 'string'},
  68             {desc => 'Max Messages Retrieved',      type => 'number'}
  69         ],
  70         return => {
  71             desc => 'List of new message IDs (empty if none)',
  72             type => 'array'
  73         }
  74     }
  75 );
  76
  77 sub retrieve_core {
  78     my ($self, $e, $set, $max) = @_;    # $e is a working editor
  79
  80     $e   ||= new_editor();
  81     $set ||= __PACKAGE__->retrieve_vendors($e);
  82
  83     my @return = ();
  84     my $vcount = 0;
  85     foreach my $account (@$set) {
  86         my $count = 0;
  87         my $server;
  88         $logger->info("EDI check for vendor " . ++$vcount . " of " . scalar(@$set) . ": " . $account->host);
  89         unless ($server = __PACKAGE__->remote_account($account)) {   # assignment, not comparison
  90             $logger->err(sprintf "Failed remote account connection for %s (%s)", $account->host, $account->id);
  91             next;
  92         };
  93         my @files    = $server->ls({remote_file => ($account->in_dir || '.')});
  94         my @ok_files = grep {$_ !~ /\/\.?\.$/ } @files;
  95         $logger->info(sprintf "%s of %s files at %s/%s", scalar(@ok_files), scalar(@files), $account->host, ($account->in_dir || ''));
  96         foreach (@ok_files) {
  97             ++$count;
  98             $max and $count > $max and last;
  99             my $content;
 100             my $io = IO::Scalar->new(\$content);
 101             unless ($server->get({remote_file => $_, local_file => $io})) {
 102                 $logger->error("(S)FTP get($_) failed");
 103                 next;
 104             }
 105             my $incoming = Fieldmapper::acq::edi_message->new;
 106             $incoming->remote_file($_);
 107             $incoming->edi($content);
 108             $incoming->account($account->id);
 109              __PACKAGE__->attempt_translation($incoming);
 110             $e->xact_begin;
 111             $e->create_acq_edi_message($incoming);
 112             $e->xact_commit;
 113             __PACKAGE__->record_activity($account, $e);
 114             __PACKAGE__->process_jedi($incoming, $e);
 115 #           $server->delete(remote_file => $_);   # delete remote copies of saved message
 116             push @return, $incoming->id;
 117         }
 118     }
 119     return \@return;
 120 }
 121
 122 # ->send_core
 123 # $account     is a Fieldmapper object for acq.edi_account row
 124 # $messageset  is an arrayref with acq.edi_message.id values
 125 # $e           is optional editor object
 126 sub send_core {
 127     my ($class, $account, $message_ids, $e) = @_;    # $e is a working editor
 128
 129     ($account and scalar @$message_ids) or return;
 130     $e ||= new_editor();
 131
 132     my @messageset = map {$e->retrieve_acq_edi_message($_)} @$message_ids;
 133     my $m_count = scalar(@messageset);
 134     (scalar(@$message_ids) == $m_count) or
 135         $logger->warn(scalar(@$message_ids) - $m_count . " bad IDs passed to send_core (ignored)");
 136
 137     my $log_str = sprintf "EDI send to edi_account %s (%s)", $account->id, $account->host;
 138     $logger->info("$log_str: $m_count message(s)");
 139     $m_count or return;
 140
 141     my $server;
 142     my $server_error;
 143     unless ($server = __PACKAGE__->remote_account($account, 1)) {   # assignment, not comparison
 144         $logger->error("Failed remote account connection for $log_str");
 145         $server_error = 1;
 146     };
 147     foreach (@messageset) {
 148         $_ or next;     # we already warned about bum ids
 149         my ($res, $error);
 150         if ($server_error) {
 151             $error = "Server error: Failed remote account connection for $log_str"; # already told $logger, this is to update object below
 152         } elsif (! $_->edi) {
 153             $logger->error("Message (id " . $_->id. ") for $log_str has no EDI content");
 154             $error = "EDI empty!";
 155         } elsif ($res = $server->put({remote_path => $account->path, content => $_->edi})) {
 156             #  This is the successful case!
 157             $_->remote_file($res);
 158             $_->status('complete');
 159             $_->process_time('NOW');    # For outbound files, sending is the end of processing on the EG side.
 160             $logger->info("Sent message (id " . $_->id. ") via $log_str");
 161         } else {
 162             $logger->error("(S)FTP put to $log_str FAILED: " . ($server->error || 'UNKOWNN'));
 163             $error = "put FAILED: " . ($server->error || 'UNKOWNN');
 164         }
 165         if ($error) {
 166             $_->error($error);
 167             $_->error_time('NOW');
 168         }
 169         $logger->info("Calling update_acq_edi_message");
 170         $e->xact_begin;
 171         unless ($e->update_acq_edi_message($_)) {
 172              $logger->error("EDI send_core update_acq_edi_message failed for message object: " . Dumper($_));
 173              OpenILS::Application::Acq::EDI::Translator->debug_file(Dumper($_              ), '/tmp/update_acq_edi_message.FAIL');
 174              OpenILS::Application::Acq::EDI::Translator->debug_file(Dumper($_->to_bare_hash), '/tmp/update_acq_edi_message.FAIL.to_bare_hash');
 175         }
 176         # There's always an update, even if we failed.
 177         $e->xact_commit;
 178         __PACKAGE__->record_activity($account, $e);  # There's always an update, even if we failed.
 179     }
 180     return \@messageset;
 181 }
 182
 183 #  attempt_translation does not touch the DB, just the object.
 184 sub attempt_translation {
 185     my ($class, $edi_message, $to_edi) = @_;
 186     my $tran  = translator();
 187     my $ret   = $to_edi ? $tran->json2edi($edi_message->jedi) : $tran->edi2json($edi_message->edi);
 188 #   $logger->error("json: " . Dumper($json)); # debugging
 189     if (not $ret or (! ref($ret)) or $ret->is_fault) {      # RPC::XML::fault on failure
 190         $edi_message->status('trans_error');
 191         $edi_message->error_time('NOW');
 192         my $pre = "EDI Translator " . ($to_edi ? 'json2edi' : 'edi2json') . " failed";
 193         my $message = ref($ret) ?
 194                       ("$pre, Error " . $ret->code . ": " . __PACKAGE__->nice_string($ret->string)) :
 195                       ("$pre: "                           . __PACKAGE__->nice_string($ret)        ) ;
 196         $edi_message->error($message);
 197         $logger->error(  $message);
 198         return;
 199     }
 200     $edi_message->status('translated');
 201     $edi_message->translate_time('NOW');
 202     if ($to_edi) {
 203         $edi_message->edi($ret->value);    # translator returns an object
 204     } else {
 205         $edi_message->jedi($ret->value);   # translator returns an object
 206     }
 207     return $edi_message;
 208 }
 209
 210 sub retrieve_vendors {
 211     my ($self, $e, $vendor_id, $last_activity) = @_;    # $e is a working editor
 212
 213     $e ||= new_editor();
 214
 215     my $criteria = {'+acqpro' => {active => 't'}};
 216     # $criteria->{vendor_id} = $vendor_id if $vendor_id;
 217     return $e->search_acq_edi_account([
 218         $criteria, {
 219             'join' => 'acqpro',
 220             flesh => 1,
 221             flesh_fields => {
 222                 acqedi => ['provider']
 223             }
 224         }
 225     ]);
 226 #   {"id":{"!=":null},"+acqpro":{"active":"t"}}, {"join":"acqpro", "flesh_fields":{"acqedi":["provider"]},"flesh":1}
 227 }
 228
 229 # This is the SRF-exposed call, so it does checkauth
 230
 231 sub retrieve {
 232     my ($self, $conn, $auth, $vendor_id, $last_activity, $max) = @_;
 233
 234     my $e = new_editor(authtoken=>$auth);
 235     unless ($e and $e->checkauth()) {
 236         $logger->warn("checkauth failed for authtoken '$auth'");
 237         return ();
 238     }
 239     # return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency);  # add permission here ?
 240
 241     my $set = __PACKAGE__->retrieve_vendors($e, $vendor_id, $last_activity) or return $e->die_event;
 242     return __PACKAGE__->retrieve_core($e, $set, $max);
 243 }
 244
 245
 246 # field_map takes the hashref of vendor data with fields from acq.edi_account and
 247 # maps them to the argument style needed for RemoteAccount.  It also extrapolates
 248 # data from the remote_host string for type and port, when available.
 249
 250 sub field_map {
 251     my $self   = shift;
 252     my $vendor = shift or return;
 253     my $no_override = @_ ? shift : 0;
 254     my %args = ();
 255     $verbose and $logger->warn("vendor: " . Dumper($vendor));
 256     foreach (keys %map) {
 257         $args{$map{$_}} = $vendor->$_ if defined $vendor->$_;
 258     }
 259     unless ($no_override) {
 260         $args{remote_path} = $vendor->in_dir;    # override "path" with "in_dir"
 261     }
 262     my $host = $args{remote_host} || '';
 263     ($host =~ /^(S?FTP):/i    and $args{type} = uc($1)) or
 264     ($host =~ /^(SSH|SCP):/i  and $args{type} = 'SCP' ) ;
 265      $host =~ /:(\d+)$/       and $args{port} = $1;
 266     $verbose and $logger->warn("field_map: " . Dumper(\%args));
 267     return %args;
 268 }
 269
 270
 271 # The point of remote_account is to get the RemoteAccount object with args from the DB
 272
 273 sub remote_account {
 274     my ($self, $vendor, $outbound, $e) = @_;
 275
 276     unless (ref($vendor)) {     # It's not a hashref/object.
 277         $vendor or return;      # If in fact it's nothing: abort!
 278                                 # else it's a vendor_id string, so get the full vendor data
 279         $e ||= new_editor();
 280         my $set_of_one = $self->retrieve_vendors($e, $vendor) or return;
 281         $vendor = shift @$set_of_one;
 282     }
 283
 284     return OpenILS::Utils::RemoteAccount->new(
 285         $self->field_map($vendor, $outbound)
 286     );
 287 }
 288
 289 sub record_activity {
 290     my ($class, $account, $e) = @_;
 291     $account or return;
 292     $e ||= new_editor();
 293     $logger->info("EDI record_activity calling update_acq_edi_account");
 294     $account->last_activity('NOW') or return;
 295     $e->xact_begin;
 296     $e->update_acq_edi_account($account) or $logger->warn("EDI: in record_activity, update_acq_edi_account FAILED");
 297     $e->xact_commit;
 298     return $account;
 299 }
 300
 301 sub nice_string {
 302     my $class = shift;
 303     my $string = shift or return '';
 304     chomp($string);
 305     my $head   = @_ ? shift : 100;
 306     my $tail   = @_ ? shift :  25;
 307     (length($string) < $head + $tail) and return $string;
 308     my $h = substr($string,0,$head);
 309     my $t = substr($string, -1*$tail);
 310     $h =~s/\s*$//o;
 311     $t =~s/\s*$//o;
 312     return "$h ... $t";
 313     # return substr($string,0,$head) . "... " . substr($string, -1*$tail);
 314 }
 315
 316 sub jedi2perl {
 317     my ($class, $jedi) = @_;
 318     $jedi or return;
 319     my $msg = OpenSRF::Utils::JSON->JSON2perl( $jedi );
 320     open (FOO, ">>/tmp/joe_jedi_dump.txt");
 321     print FOO Dumper($msg), "\n\n";
 322     close FOO;
 323     $logger->warn("Dumped JSON2perl to /tmp/JSON2perl_dump.txt");
 324     return $msg;
 325 }
 326
 327 # ->process_jedi($message, $e)
 328 sub process_jedi {
 329     my $class    = shift;
 330     my $message  = shift or return;
 331     my $jedi     = ref($message) ? $message->jedi : $message;  # If we got an object, it's an edi_message.  A string is the jedi content itself.
 332     unless ($jedi) {
 333         $logger->warn("EDI process_jedi missing required argument (edi_message object with jedi or jedi scalar)!");
 334         return;
 335     }
 336     my $perl = __PACKAGE__->jedi2perl($jedi);
 337     if (ref($message) and not $perl) {
 338         my $e = @_ ? shift : new_editor();
 339         $message->error(($message->error || '') . " JSON2perl FAILED to convert jedi");
 340         $message->error_time('NOW');
 341         $e->xact_begin;
 342         $e->udpate_acq_edi_message($message) or $logger->warn("EDI update_acq_edi_message failed! $!");
 343         $e->xact_commit;
 344     }
 345     # __PACKAGE__->process_eval_msg(__PACKAGE__->jedi2perl($jedi), @_);
 346     return $perl;   # TODO process perl
 347 }
 348
 349 sub process_eval_msg {
 350     my ($class, $msg, $e) = @_;
 351     $msg or return;
 352     $e ||= new_editor();
 353 ## Do all the hard work.
 354 #   ID the message type
 355 #   Find PO references
 356 #   update POs & lineitems(?)
 357 }
 358
 359 1;
 360