Open-ILS/src/perlmods/lib/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::Application::Acq::Lineitem;
  14 use OpenILS::Application::Acq::Invoice;
  15 use OpenILS::Utils::RemoteAccount;
  16 use OpenILS::Utils::CStoreEditor q/new_editor/;
  17 use OpenILS::Utils::Fieldmapper;
  18 use OpenILS::Application::Acq::EDI::Translator;
  19 use OpenILS::Application::AppUtils;
  20 my $U = 'OpenILS::Application::AppUtils';
  21
  22 use OpenILS::Utils::EDIReader;
  23
  24 use Data::Dumper;
  25 $Data::Dumper::Indent = 0;
  26 our $verbose = 0;
  27
  28 sub new {
  29     my($class, %args) = @_;
  30     my $self = bless(\%args, $class);
  31     # $self->{args} = {};
  32     return $self;
  33 }
  34
  35 # our $reasons = {};   # cache for acq.cancel_reason rows ?
  36
  37 our $translator;
  38
  39 sub translator {
  40     return $translator ||= OpenILS::Application::Acq::EDI::Translator->new(@_);
  41 }
  42
  43 my %map = (
  44     host     => 'remote_host',
  45     username => 'remote_user',
  46     password => 'remote_password',
  47     account  => 'remote_account',
  48     # in_dir   => 'remote_path',   # field_map overrides path with in_dir
  49     path     => 'remote_path',
  50 );
  51
  52 my $VENDOR_KLUDGE_MAP = {
  53     INVOIC => {
  54         amount_billed_is_per_unit => [1699342]
  55     },
  56     ORDRSP => {
  57     }
  58 };
  59
  60
  61 __PACKAGE__->register_method(
  62     method    => 'retrieve',
  63     api_name  => 'open-ils.acq.edi.retrieve',
  64     authoritative => 1,
  65     signature => {
  66         desc   => 'Fetch incoming message(s) from EDI accounts.  ' .
  67                   'Optional arguments to restrict to one vendor and/or a max number of messages.  ' .
  68                   'Note that messages are not parsed or processed here, just fetched and translated.',
  69         params => [
  70             {desc => 'Authentication token',        type => 'string'},
  71             {desc => 'Vendor ID (undef for "all")', type => 'number'},
  72             {desc => 'Date Inactive Since',         type => 'string'},
  73             {desc => 'Max Messages Retrieved',      type => 'number'}
  74         ],
  75         return => {
  76             desc => 'List of new message IDs (empty if none)',
  77             type => 'array'
  78         }
  79     }
  80 );
  81
  82 sub retrieve_core {
  83     my ($self, $set, $max, $e, $test) = @_;    # $e is a working editor
  84
  85     $e   ||= new_editor();
  86     $set ||= __PACKAGE__->retrieve_vendors($e);
  87
  88     my @return = ();
  89     my $vcount = 0;
  90     foreach my $account (@$set) {
  91         my $count = 0;
  92         my $server;
  93         $logger->info(
  94             "EDI check for vendor " .
  95             ++$vcount . " of " . scalar(@$set) . ": " . $account->host
  96         );
  97         unless ($server = __PACKAGE__->remote_account($account)) { # assignment
  98             $logger->err(
  99                 sprintf "Failed remote account mapping for %s (%s)",
 100                 $account->host, $account->id
 101             );
 102             next;
 103         };
 104
 105         if ($account->in_dir) {
 106             if ($account->in_dir =~ /\*+.*\//) {
 107                 $logger->err(
 108                     "EDI in_dir has a slash after an asterisk in value: '" .
 109                     $account->in_dir .
 110                     "'.  Skipping account with indeterminate target dir!"
 111                 );
 112                 next;
 113             }
 114         }
 115
 116         my @files    = ($server->ls({remote_file => ($account->in_dir || './')}));
 117         my @ok_files = grep {$_ !~ /\/\.?\.$/ and $_ ne '0'} @files;
 118         $logger->info(sprintf "%s of %s files at %s/%s", scalar(@ok_files), scalar(@files), $account->host, $account->in_dir || "");
 119
 120         foreach my $remote_file (@ok_files) {
 121             my $description = sprintf "%s/%s", $account->host, $remote_file;
 122
 123             # deduplicate vs. acct/filenames already in DB.
 124             #
 125             # The reason we match against host/username/password/in_dir
 126             # is that there may be many variant accounts that point to the
 127             # same FTP site and credentials.  If we only checked based on
 128             # acq.edi_account.id, we'd not find out in those cases that we've
 129             # already processed the same file before.
 130             my $hits = $e->search_acq_edi_message(
 131                 [
 132                     {
 133                         "+acqedi" => {
 134                             host => $account->host,
 135                             username => $account->username,
 136                             password => $account->password,
 137                             in_dir => $account->in_dir
 138                         },
 139                         remote_file => {'=' => {
 140                             transform => 'evergreen.lowercase',
 141                             value => ['evergreen.lowercase', $remote_file]
 142                         }},
 143                         status      => {'in' => [qw/ processed proc_error trans_error /]},
 144                     },
 145                     { join => {"acqedi" => {}}, limit => 1 }
 146                 ], { idlist => 1 }
 147             );
 148
 149             if (!$hits) {
 150                 my $msg = "EDI: test for already-retrieved files yielded " .
 151                     "event " . $e->event->{textcode};
 152                 $logger->warn($msg);
 153                 warn $msg;
 154                 return $e->die_event;
 155             }
 156
 157             if (@$hits) {
 158                 $logger->debug("EDI: $remote_file already retrieved.  Skipping");
 159                 warn "EDI: $remote_file already retrieved.  Skipping";
 160                 next;
 161             }
 162
 163             ++$count;
 164             if ($max and $count > $max) {
 165                 last;
 166             }
 167
 168             $logger->info(
 169                 sprintf "%s of %s targets: %s",
 170                     $count, scalar(@ok_files), $description
 171             );
 172             printf("%d of %d targets: %s\n", $count, scalar(@ok_files), $description);
 173             if ($test) {
 174                 push @return, "test_$count";
 175                 next;
 176             }
 177             my $content;
 178             my $io = IO::Scalar->new(\$content);
 179
 180             unless (
 181                 $server->get({remote_file => $remote_file, local_file => $io})
 182             ) {
 183                 $logger->error("(S)FTP get($description) failed");
 184                 next;
 185             }
 186
 187             my $incoming = __PACKAGE__->process_retrieval(
 188                 $content, $remote_file, $server, $account->id
 189             );
 190
 191             push @return, @$incoming;
 192         }
 193     }
 194     return \@return;
 195 }
 196
 197
 198 # procses_retrieval() returns a reference to a list of acq.edi_message IDs
 199 sub process_retrieval {
 200     my ($class, $content, $filename, $server, $account_or_id) = @_;
 201     $content or return;
 202
 203     my $e = new_editor;
 204     my $account = __PACKAGE__->record_activity($account_or_id, $e);
 205
 206     # a single EDI blob can contain multiple messages
 207     # create one edi_message per included message
 208
 209     my $messages = OpenILS::Utils::EDIReader->new->read($content);
 210     my @return;
 211
 212     for my $msg_hash (@$messages) {
 213
 214         my $incoming = Fieldmapper::acq::edi_message->new;
 215
 216         $incoming->remote_file($filename);
 217         $incoming->account($account->id);
 218         $incoming->edi($content);
 219         $incoming->message_type($msg_hash->{message_type});
 220         $incoming->jedi(OpenSRF::Utils::JSON->perl2JSON($msg_hash)); # jedi-2.0
 221         $incoming->status('translated');
 222         $incoming->translate_time('NOW');
 223
 224         if ($msg_hash->{purchase_order}) {
 225             # Some vendors just put their name where there ought to be a number,
 226             # and others put alphanumeric strings that mean nothing to us, so
 227             # we sure won't match a PO in the system this way. We can pick
 228             # up PO number later from the lineitems themselves if necessary.
 229
 230             if ($msg_hash->{purchase_order} !~ /^\d+$/) {
 231                 $logger->warn("EDI: PO identifier is non-numeric. Blanking and continuing.");
 232                 undef $msg_hash->{purchase_order};
 233             } else {
 234                 $logger->info("EDI: processing message for PO " .
 235                     $msg_hash->{purchase_order});
 236                 $incoming->purchase_order($msg_hash->{purchase_order});
 237                 unless ($e->retrieve_acq_purchase_order(
 238                         $incoming->purchase_order)) {
 239                     $logger->warn("EDI: received order response for " .
 240                         "nonexistent PO.  Skipping...");
 241                     next;
 242                 }
 243             }
 244         }
 245
 246         $e->xact_begin;
 247         unless($e->create_acq_edi_message($incoming)) {
 248             $logger->error("EDI: unable to create edi_message " . $e->die_event);
 249             next;
 250         }
 251         # refresh to pickup create_date, etc.
 252         $incoming = $e->retrieve_acq_edi_message($incoming->id);
 253         $e->xact_commit;
 254
 255         # since there's a fair chance of unhandled problems
 256         # cropping up, particularly with new vendors, wrap w/ eval.
 257         eval { $class->process_parsed_msg($account, $incoming, $msg_hash) };
 258
 259         $e->xact_begin;
 260         if ($@) {
 261             $incoming = $e->retrieve_acq_edi_message($incoming->id);
 262             $logger->error($@);
 263             $incoming->status('proc_error');
 264             $incoming->error_time('now');
 265             $incoming->error($@);
 266         } else {
 267             $incoming->status('processed');
 268         }
 269         $e->update_acq_edi_message($incoming);
 270         $e->xact_commit;
 271
 272         push(@return, $incoming->id);
 273     }
 274
 275     return \@return;
 276 }
 277
 278 # ->send_core
 279 # $account     is a Fieldmapper object for acq.edi_account row
 280 # $message_ids is an arrayref with acq.edi_message.id values
 281 # $e           is optional editor object
 282 sub send_core {
 283     my ($class, $account, $message_ids, $e) = @_;    # $e is a working editor
 284
 285     return unless $account and @$message_ids;
 286     $e ||= new_editor();
 287
 288     $e->xact_begin;
 289     my @messageset = map {$e->retrieve_acq_edi_message($_)} @$message_ids;
 290     $e->xact_rollback;
 291     my $m_count = scalar(@messageset);
 292     if (@$message_ids != $m_count) {
 293         $logger->warn(scalar(@$message_ids) - $m_count . " bad IDs passed to send_core (ignored)");
 294     }
 295
 296     my $log_str = sprintf "EDI send to edi_account %s (%s)", $account->id, $account->host;
 297     $logger->info("$log_str: $m_count message(s)");
 298     return unless $m_count;
 299
 300     my $server;
 301     my $server_error;
 302     unless ($server = __PACKAGE__->remote_account($account, 1)) { # assignment
 303         $logger->error("Failed remote account connection for $log_str");
 304         $server_error = 1;
 305     }
 306
 307     foreach (@messageset) {
 308         $_ or next;     # we already warned about bum ids
 309         my ($res, $error);
 310         if ($server_error) {
 311             # We already told $logger; this is to update object below
 312             $error = "Server error: Failed remote account connection ".
 313                 "for $log_str";
 314         } elsif (! $_->edi) {
 315             $logger->error(
 316                 "Message (id " . $_->id. ") for $log_str has no EDI content"
 317             );
 318             $error = "EDI empty!";
 319         } elsif (
 320             $res = $server->put({
 321                 remote_path => $account->path, content => $_->edi,
 322                     single_ext => 1
 323             })
 324         ) {
 325             #  This is the successful case!
 326             $_->remote_file($res);
 327             $_->status('complete');
 328             $_->process_time('NOW');
 329
 330             # For outbound files, sending is the end of processing on
 331             # the EG side.
 332
 333             $logger->info("Sent message (id " . $_->id. ") via $log_str");
 334         } else {
 335             $logger->error(
 336                 "(S)FTP put to $log_str FAILED: " .
 337                 ($server->error || 'UNKOWNN')
 338             );
 339             $error = "put FAILED: " . ($server->error || 'UNKOWNN');
 340         }
 341
 342         if ($error) {
 343             $_->error($error);
 344             $_->error_time('NOW');
 345         }
 346
 347         $logger->info("Calling update_acq_edi_message");
 348         $e->xact_begin;
 349
 350         unless ($e->update_acq_edi_message($_)) {
 351              $logger->error(
 352                  "EDI send_core update_acq_edi_message failed " .
 353                  "for message object: " . Dumper($_)
 354              );
 355
 356              OpenILS::Application::Acq::EDI::Translator->debug_file(
 357                  Dumper($_),
 358                  '/tmp/update_acq_edi_message.FAIL'
 359              );
 360              OpenILS::Application::Acq::EDI::Translator->debug_file(
 361                  Dumper($_->to_bare_hash),
 362                  '/tmp/update_acq_edi_message.FAIL.to_bare_hash'
 363              );
 364         }
 365
 366         # There's always an update, even if we failed.
 367         $e->xact_commit;
 368         __PACKAGE__->record_activity($account, $e);
 369     }
 370     return \@messageset;
 371 }
 372
 373 #  attempt_translation does not touch the DB, just the object.
 374 sub attempt_translation {
 375     my ($class, $edi_message, $to_edi) = @_;
 376
 377     my $ret = $to_edi ? translator->json2edi($edi_message->jedi) :
 378         translator->edi2json($edi_message->edi);
 379
 380     if (not $ret or (! ref($ret)) or $ret->is_fault) {
 381         # RPC::XML::fault on failure
 382
 383         $edi_message->status('trans_error');
 384         $edi_message->error_time('NOW');
 385         my $pre = "EDI Translator " .
 386             ($to_edi ? 'json2edi' : 'edi2json') . " failed";
 387
 388         my $message = ref($ret) ?
 389             ("$pre, Error " . $ret->code . ": " .
 390                 __PACKAGE__->nice_string($ret->string)) :
 391             ("$pre: " . __PACKAGE__->nice_string($ret)) ;
 392
 393         $edi_message->error($message);
 394         $logger->error($message);
 395         return;
 396     }
 397
 398     $edi_message->status('translated');
 399     $edi_message->translate_time('NOW');
 400
 401     if ($to_edi) {
 402         $edi_message->edi($ret->value);    # translator returns an object
 403     } else {
 404         $edi_message->jedi($ret->value);   # translator returns an object
 405     }
 406
 407     return $edi_message;
 408 }
 409
 410 sub retrieve_vendors {
 411     my ($self, $e, $vendor_id, $last_activity) = @_;    # $e is a working editor
 412
 413     $e ||= new_editor();
 414
 415     my $criteria = {'+acqpro' => {active => 't'}};
 416     $criteria->{'+acqpro'}->{id} = $vendor_id if $vendor_id;
 417     return $e->search_acq_edi_account([
 418         $criteria, {
 419             'join' => 'acqpro',
 420             flesh => 1,
 421             flesh_fields => {
 422                 acqedi => ['provider']
 423             }
 424         }
 425     ]);
 426 }
 427
 428 # This is the SRF-exposed call, so it does checkauth
 429
 430 sub retrieve {
 431     my ($self, $conn, $auth, $vendor_id, $last_activity, $max) = @_;
 432
 433     my $e = new_editor(authtoken=>$auth);
 434     unless ($e and $e->checkauth()) {
 435         $logger->warn("checkauth failed for authtoken '$auth'");
 436         return ();
 437     }
 438     # return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency);  # add permission here ?
 439
 440     my $set = __PACKAGE__->retrieve_vendors($e, $vendor_id, $last_activity) or return $e->die_event;
 441     return __PACKAGE__->retrieve_core($e, $set, $max);
 442 }
 443
 444
 445 # field_map takes the hashref of vendor data with fields from acq.edi_account and
 446 # maps them to the argument style needed for RemoteAccount.  It also extrapolates
 447 # data from the remote_host string for type and port, when available.
 448
 449 sub field_map {
 450     my $self   = shift;
 451     my $vendor = shift or return;
 452     my $no_override = @_ ? shift : 0;
 453     my %args = ();
 454     $verbose and $logger->warn("vendor: " . Dumper($vendor));
 455     foreach (keys %map) {
 456         $args{$map{$_}} = $vendor->$_ if defined $vendor->$_;
 457     }
 458     unless ($no_override) {
 459         $args{remote_path} = $vendor->in_dir;    # override "path" with "in_dir"
 460     }
 461     my $host = $args{remote_host} || '';
 462     ($host =~ s/^(S?FTP)://i    and $args{type} = uc($1)) or
 463     ($host =~ s/^(SSH|SCP)://i  and $args{type} = 'SCP' ) ;
 464      $host =~ s/:(\d+)$//       and $args{port} = $1;
 465     ($args{remote_host} = $host) =~ s#/+##;
 466     $verbose and $logger->warn("field_map: " . Dumper(\%args));
 467     return %args;
 468 }
 469
 470
 471 # The point of remote_account is to get the RemoteAccount object with args from the DB
 472
 473 sub remote_account {
 474     my ($self, $vendor, $outbound, $e) = @_;
 475
 476     unless (ref($vendor)) {     # It's not a hashref/object.
 477         $vendor or return;      # If in fact it's nothing: abort!
 478                                 # else it's a vendor_id string, so get the full vendor data
 479         $e ||= new_editor();
 480         my $set_of_one = $self->retrieve_vendors($e, $vendor) or return;
 481         $vendor = shift @$set_of_one;
 482     }
 483
 484     return OpenILS::Utils::RemoteAccount->new(
 485         $self->field_map($vendor, $outbound)
 486     );
 487 }
 488
 489 # takes account ID or account Fieldmapper object
 490
 491 sub record_activity {
 492     my ($class, $account_or_id, $e) = @_;
 493     $account_or_id or return;
 494     $e ||= new_editor();
 495     my $account = ref($account_or_id) ? $account_or_id : $e->retrieve_acq_edi_account($account_or_id);
 496     $logger->info("EDI record_activity calling update_acq_edi_account");
 497     $account->last_activity('NOW') or return;
 498     $e->xact_begin;
 499     $e->update_acq_edi_account($account) or $logger->warn("EDI: in record_activity, update_acq_edi_account FAILED");
 500     $e->xact_commit;
 501     return $account;
 502 }
 503
 504 sub nice_string {
 505     my $class = shift;
 506     my $string = shift or return '';
 507     chomp($string);
 508     my $head   = @_ ? shift : 100;
 509     my $tail   = @_ ? shift :  25;
 510     (length($string) < $head + $tail) and return $string;
 511     my $h = substr($string,0,$head);
 512     my $t = substr($string, -1*$tail);
 513     $h =~s/\s*$//o;
 514     $t =~s/\s*$//o;
 515     return "$h ... $t";
 516     # return substr($string,0,$head) . "... " . substr($string, -1*$tail);
 517 }
 518
 519 # process_message_buyer() is used in processing both INVOIC
 520 # messages as well as ORDRSP ones.  As such, the $eg_inv parameter is
 521 # optional.
 522 sub process_message_buyer {
 523     my ($class, $e, $msg_hash, $message,  $log_prefix, $eg_inv) = @_;
 524
 525     my $vendcode = $msg_hash->{buyer_code};
 526
 527     # some vendors encode the account number as the SAN.
 528     # starting with the san value, then the account value,
 529     # treat each as a san, then an acct number until the first success
 530     for my $buyer ( ($msg_hash->{buyer_san},
 531         $msg_hash->{buyer_acct}, $msg_hash->{buyer_ident}) ) {
 532
 533         next unless $buyer;
 534
 535         # some vendors encode the SAN as "$SAN $vendcode"
 536         if (!$vendcode) {
 537             ($buyer, $vendcode) = $buyer =~ /(\S+)\s*(\S+)?$/;
 538         }
 539
 540         my $addr = $e->search_actor_org_address(
 541             {valid => "t", san => $buyer})->[0];
 542
 543         if ($addr) {
 544
 545             $eg_inv->receiver($addr->org_unit) if $eg_inv;
 546
 547             my $orig_acct = $e->retrieve_acq_edi_account($message->account);
 548
 549             if (defined($vendcode) and ($orig_acct->vendcode ne $vendcode)) {
 550                 # The vendcode can give us the opportunity to change the
 551                 # acq.edi_account with which our acq.edi_message is associated
 552                 # in case it's wrong.
 553
 554                 my $other_accounts = $e->search_acq_edi_account(
 555                     {
 556                         vendcode => $vendcode,
 557                         host => $orig_acct->host,
 558                         username => $orig_acct->username,
 559                         password => $orig_acct->password,
 560                         in_dir => $orig_acct->in_dir
 561                     }
 562                 );
 563
 564                 if (@$other_accounts) {
 565                     # We can update this object because the caller saves
 566                     # it with cstore later.
 567                     $message->account($other_accounts->[0]->id);
 568
 569                     $logger->info(
 570                         $log_prefix . sprintf(
 571                             "changing edi_account from %d to %d based on " .
 572                             "vendcode '%s' (%d match(es))",
 573                             $orig_acct->id, $message->account, $vendcode,
 574                             scalar(@$other_accounts)
 575                         )
 576                     );
 577
 578                     # If we've updated the message's account, and if we're
 579                     # dealing with an invoice, we should update the invoice's
 580                     # provider and shipper fields. XXX what's the difference
 581                     # between shipper and provider, really?
 582                     if ($eg_inv) {
 583                         $eg_inv->provider(
 584                             $eg_inv->shipper($other_accounts->[0]->provider)
 585                         );
 586                     }
 587                 }
 588             }
 589
 590             last;
 591
 592         } else {
 593
 594             my $accts = $e->search_acq_edi_account({vendacct => $buyer});
 595
 596             if (@$accts) {
 597                 if (grep { $_->id == $message->account } @$accts) {
 598                     $logger->warn(
 599                         $log_prefix . sprintf(
 600                             "Not changing edi_account because we found " .
 601                             "(%d) matching vendacct(s), one of which " .
 602                             "being on the edi_account we already had",
 603                             scalar(@$accts)
 604                         )
 605                     );
 606                 }
 607
 608                 $logger->info(
 609                     $log_prefix . sprintf(
 610                         "changing edi_account from %d to %d based on " .
 611                         "vendacct '%s' (%d match(es))",
 612                         $message->account, $accts->[0]->id, $buyer,
 613                         scalar(@$accts)
 614                     )
 615                 );
 616
 617                 # Both $message and $eg_inv should be saved later by the caller.
 618                 $message->account($accts->[0]->id);
 619                 if ($eg_inv) {
 620                     $eg_inv->receiver($accts->[0]->owner);
 621                     $eg_inv->provider(
 622                         $eg_inv->shipper($accts->[0]->provider)
 623                     );
 624                 }
 625
 626                 last;
 627             }
 628         }
 629     }
 630 }
 631
 632 # parts of this process can fail without the entire
 633 # thing failing.  If a catastrophic error occurs,
 634 # it will occur via die.
 635 sub process_parsed_msg {
 636     my ($class, $account, $incoming, $msg_hash) = @_;
 637
 638     # INVOIC
 639     if ($incoming->message_type eq 'INVOIC') {
 640         return $class->create_acq_invoice_from_edi(
 641             $msg_hash, $account->provider, $incoming);
 642
 643     } elsif ($incoming->message_type eq 'DESADV') {
 644         return $class->create_shipment_notification_from_edi(
 645             $msg_hash, $account->provider, $incoming);
 646     }
 647
 648     # ORDRSP
 649
 650     #  First do this for the whole message...
 651     $class->process_message_buyer(
 652         new_editor, $msg_hash, $incoming, "ORDRSP processing"
 653     );
 654
 655     #  ... now do this stuff per-lineitem.
 656     for my $li_hash (@{$msg_hash->{lineitems}}) {
 657         my $e = new_editor(xact => 1);
 658
 659         my $li_id = $li_hash->{id};
 660         my $li = $e->retrieve_acq_lineitem($li_id);
 661
 662         if (!$li) {
 663             $logger->error("EDI: request for invalid lineitem ID '$li_id'");
 664             $e->rollback;
 665             next;
 666         }
 667
 668          $li->expected_recv_time(
 669             $class->edi_date_to_iso($li_hash->{expected_date}));
 670
 671         $li->estimated_unit_price($li_hash->{unit_price});
 672
 673         if (not $incoming->purchase_order) {
 674             # PO should come from the EDI message, but if not...
 675
 676             # NOTE: We used to refetch $incoming here, but that discarded
 677             # changes made by process_message_buyer() above, and is not
 678             # necessary since our caller just did that before invoking us.
 679
 680             $incoming->purchase_order($li->purchase_order);
 681
 682             # NOTE: $li *just* came from the database, so if this update fails
 683             # we should actually die() and thereby abort any changes from this
 684             # entire message, because something weird is happening.
 685             die(
 686                 "EDI: unable to update edi_message ". $e->die_event->{textcode}
 687             ) unless $e->update_acq_edi_message($incoming);
 688         }
 689
 690         my $lids = $e->json_query({
 691             select => {acqlid => ['id']},
 692             from => 'acqlid',
 693             where => {lineitem => $li->id}
 694         });
 695
 696         my @lids = map { $_->{id} } @$lids;
 697         my $lid_count = scalar(@lids);
 698         my $lids_covered = 0;
 699         my $lids_cancelled = 0;
 700         my $order_qty;
 701         my $dispatch_qty;
 702
 703         for my $qty (@{$li_hash->{quantities}}) {
 704
 705             my $qty_count = $qty->{quantity};
 706             my $qty_code = $qty->{code};
 707
 708             next unless defined $qty_count;
 709
 710             if (!$qty_code) {
 711                 $logger->warn("EDI: Response for LI $li_id specifies quantity ".
 712                     "$qty_count with no 6063 code! Contact vendor to resolve.");
 713                 next;
 714             }
 715
 716             $logger->info("EDI: LI $li_id processing quantity count=$qty_count / code=$qty_code");
 717
 718             if ($qty_code eq '21') { # "ordered quantity"
 719                 $order_qty = $qty_count;
 720                 $logger->info("EDI: LI $li_id -- vendor confirms $qty_count ordered");
 721                 $logger->warn("EDI: LI $li_id -- order count $qty_count ".
 722                     "does not match LID count $lid_count") unless $qty_count == $lid_count;
 723                 next;
 724             }
 725
 726             $lids_covered += $qty_count;
 727
 728             if ($qty_code eq '12') {
 729                 $dispatch_qty = $qty_count;
 730                 $logger->info("EDI: LI $li_id -- vendor dispatched $qty_count");
 731                 next;
 732
 733             } elsif ($qty_code eq '57') {
 734                 $logger->info("EDI: LI $li_id -- $qty_count in transit");
 735                 next;
 736             }
 737             # 84: urgent delivery
 738             # 118: quantity manifested
 739             # ...
 740
 741             # -------------------------------------------------------------------------
 742             # All of the remaining quantity types require that we apply a cancel_reason
 743             # DB populated w/ 6063 keys in 1200's
 744
 745             my $eg_reason = $e->retrieve_acq_cancel_reason(1200 + $qty_code);
 746
 747             if (!$eg_reason) {
 748                 $logger->warn("EDI: Unhandled quantity qty_code '$qty_code' ".
 749                     "for li $li_id.  $qty_count items unprocessed");
 750                 next;
 751             }
 752
 753             my ($cancel_count, $fatal) =
 754                 $class->cancel_lids($e, $eg_reason, $qty_count, $lid_count, \@lids);
 755
 756             last if $fatal;
 757
 758             $lids_cancelled += $cancel_count;
 759
 760             # if ALL the items have the same cancel_reason, the LI gets it too
 761             if ($qty_count == $lid_count) {
 762                 $li->cancel_reason($eg_reason->id);
 763                 $li->state("cancelled");
 764             }
 765
 766             $li->edit_time('now');
 767             unless ($e->update_acq_lineitem($li)) {
 768                 $logger->error("EDI: update_acq_lineitem failed " . $e->die_event);
 769                 last;
 770             }
 771         }
 772
 773         # in case the provider neglected to echo back the order count
 774         $order_qty = $lid_count unless defined $order_qty;
 775
 776         # it may be necessary to change the logic here to look for lineitem
 777         # order status / availability status instead of dispatch_qty and
 778         # assume that dispatch_qty simply equals the number of unaccounted-for copies
 779         if (defined $dispatch_qty) {
 780             # provider is telling us how may copies were delivered
 781
 782             # number of copies neither cancelled or delivered
 783             my $remaining_lids = $order_qty - ($dispatch_qty + $lids_cancelled);
 784
 785             if ($remaining_lids > 0) {
 786
 787                 # the vendor did not ship all items and failed to provide cancellation
 788                 # quantities for some or all of the items to be cancelled.  When this
 789                 # happens, we cancel the remaining un-delivered copies using the
 790                 # lineitem order status to determine the cancel reason.
 791
 792                 my $reason_id;
 793                 my $stat;
 794
 795                 if ($stat = $li_hash->{order_status}) {
 796                     $logger->info("EDI: lineitem has order status $stat");
 797
 798                     if ($stat eq '200') {
 799                         $reason_id = 1007; # not accepted
 800
 801                     } elsif ($stat eq '400') {
 802                         $reason_id = 1283; # back-order
 803                     }
 804
 805                 } elsif ($stat = $li_hash->{avail_status}) {
 806                     $logger->info("EDI: lineitem has availability status $stat");
 807
 808                     if ($stat eq 'NP') {
 809                         # not yet published
 810                         # TODO: needs cancellation?
 811                     }
 812                 }
 813
 814                 if ($reason_id) {
 815                     my $reason = $e->retrieve_acq_cancel_reason($reason_id);
 816
 817                     my ($cancel_count, $fatal) =
 818                         $class->cancel_lids($e, $reason, $remaining_lids, $lid_count, \@lids);
 819
 820                     last if $fatal;
 821                     $lids_cancelled += $cancel_count;
 822
 823                     # All LIDs cancelled with same reason, apply
 824                     # the same cancel reason to the lineitem
 825                     if ($remaining_lids == $order_qty) {
 826                         $li->cancel_reason($reason->id);
 827                         $li->state("cancelled");
 828                     }
 829
 830                     $li->edit_time('now');
 831                     unless ($e->update_acq_lineitem($li)) {
 832                         $logger->error("EDI: update_acq_lineitem failed " . $e->die_event);
 833                         last;
 834                     }
 835
 836                 } else {
 837                     $logger->warn("EDI: vendor says we ordered $order_qty and cancelled ".
 838                         "$lids_cancelled, but only shipped $dispatch_qty");
 839                 }
 840             }
 841         }
 842
 843         # LI and LIDs updated, let's wrap this one up.
 844         # this is a no-op if the xact has already been rolled back
 845         $e->commit;
 846
 847         $logger->info("EDI: LI $li_id -- $order_qty LIDs ordered; ".
 848             "$lids_cancelled LIDs cancelled");
 849     }
 850 }
 851
 852 sub cancel_lids {
 853     my ($class, $e, $reason, $count, $lid_count, $lid_ids) = @_;
 854
 855     my $cancel_count = 0;
 856
 857     foreach (1 .. $count) {
 858
 859         my $lid_id = shift @$lid_ids;
 860
 861         if (!$lid_id) {
 862             $logger->warn("EDI: Used up all $lid_count LIDs. ".
 863                 "Ignoring extra status '" . $reason->label . "'");
 864             last;
 865         }
 866
 867         my $lid = $e->retrieve_acq_lineitem_detail($lid_id);
 868         $lid->cancel_reason($reason->id);
 869
 870         # item is cancelled.  Remove the fund debit.
 871         unless ($U->is_true($reason->keep_debits)) {
 872
 873             if (my $debit_id = $lid->fund_debit) {
 874
 875                 $lid->clear_fund_debit;
 876                 my $debit = $e->retrieve_acq_fund_debit($debit_id);
 877
 878                 if ($U->is_true($debit->encumbrance)) {
 879                     $logger->info("EDI: deleting debit $debit_id for cancelled LID $lid_id");
 880
 881                     unless ($e->delete_acq_fund_debit($debit)) {
 882                         $logger->error("EDI: unable to update fund_debit " . $e->die_event);
 883                         return (0, 1);
 884                     }
 885                 } else {
 886                     # do not delete a paid-for debit
 887                     $logger->warn("EDI: cannot delete invoiced debit $debit_id");
 888                 }
 889             }
 890         }
 891
 892         $e->update_acq_lineitem_detail($lid);
 893         $cancel_count++;
 894     }
 895
 896     return ($cancel_count);
 897 }
 898
 899 sub edi_date_to_iso {
 900     my ($class, $date) = @_;
 901     return undef unless $date and $date =~ /\d+/;
 902     my ($iso, $m, $d) = $date =~ /^(\d{4})(\d{2})(\d{2})/g;
 903     $iso .= "-$m" if $m;
 904     $iso .= "-$d" if $d;
 905     return $iso;
 906 }
 907
 908
 909 # Return hash with a key for every kludge that should apply for this
 910 # msg_type (INVOIC,ORDRSP) and this vendor SAN.
 911 sub get_kludges {
 912     my ($class, $msg_type, $vendor_san) = @_;
 913
 914     my @kludges;
 915     while (my ($kludge, $vendors) = each %{$VENDOR_KLUDGE_MAP->{$msg_type}}) {
 916         push @kludges, $kludge if grep { $_ eq $vendor_san } @$vendors;
 917     }
 918
 919     return map { $_ => 1 } @kludges;
 920 }
 921
 922 sub invoice_lineitem_to_invoice_entry {
 923     my ($li, $quantity, $price) = @_;
 924
 925     my $eg_inv_entry = Fieldmapper::acq::invoice_entry->new;
 926     $eg_inv_entry->isnew(1);
 927     $eg_inv_entry->inv_item_count($quantity);
 928
 929     # amount staff agree to pay for
 930     $eg_inv_entry->phys_item_count($quantity);
 931
 932     # XXX Validate by making sure the LI is on-order and belongs to
 933     # the right provider and ordering agency and all that.
 934     $eg_inv_entry->lineitem($li->id);
 935
 936     # XXX Do we actually need to link to PO directly here?
 937     $eg_inv_entry->purchase_order($li->purchase_order);
 938
 939     # This is the total price for all units billed, not per-unit.
 940     $eg_inv_entry->cost_billed($price);
 941
 942     # amount staff agree to pay
 943     $eg_inv_entry->amount_paid($price);
 944
 945     # The EDIReader class does detect certain per-lineitem
 946     # taxes, but we'll ignore them for now, as the only sample
 947     # invoices I've yet seen containing them also had a final
 948     # cumulative tax at the end.
 949
 950     return $eg_inv_entry;
 951 }
 952
 953 # Return an arrayref containing acqie objects, an another of unknown lineitem
 954 # references from the electronic invoice.
 955 # @param    $message            An acqedim object
 956 # @param    $invoice_lineitems  An arrayref from part of EDIReader output
 957 # NOTE: This sub can have side-effects on $message.
 958 sub process_invoice_lineitems {
 959     my ($e, $msg_kludges, $log_prefix, $message, $invoice_lineitems) = @_;
 960
 961     my (@entries, @unknowns);
 962
 963     foreach my $lineitem (@$invoice_lineitems) {
 964         if (!$lineitem->{id}) {
 965             $logger->warn($log_prefix . "no lineitem ID");
 966             next;
 967         }
 968
 969         my ($quant) = grep {$_->{code} eq '47'} @{$lineitem->{quantities}};
 970         my $quantity = ($quant) ? $quant->{quantity} : 0;
 971
 972         if (!$quantity) {
 973             $logger->warn($log_prefix . "no invoice quantity " .
 974                 "specified for invoice LI $lineitem->{id}");
 975             next;
 976         }
 977
 978         # NOTE: if needed, we also have $lineitem->{net_unit_price}
 979         # and $lineitem->{gross_unit_price}
 980         my $price = $lineitem->{amount_billed};
 981
 982         # XXX Should we set acqie.billed_per_item=t in this case
 983         # instead? Not sure whether that actually works everywhere
 984         # it needs to. LFW
 985         $price *= $quantity if $msg_kludges->{amount_billed_is_per_unit};
 986
 987         my $li = $e->retrieve_acq_lineitem($lineitem->{id});
 988
 989         if ($li) {
 990             # If the top-level PO value is unset, get it from the first LI
 991             $message->purchase_order($li->purchase_order)
 992                 unless $message->purchase_order;
 993
 994             push @entries, invoice_lineitem_to_invoice_entry(
 995                 $li, $quantity, $price
 996             );
 997         } else {
 998             push @unknowns, $lineitem->{id};
 999         }
1000     }
1001
1002     return \@entries, \@unknowns;
1003 }
1004
1005 # create_acq_invoice_from_edi() does what it sounds like it does for INVOIC
1006 # messages.  For similar operation on ORDRSP messages, see the guts of
1007 # process_jedi().
1008 # Return boolean success indicator.
1009 sub create_acq_invoice_from_edi {
1010     my ($class, $msg_data, $provider, $message) = @_;
1011     # $msg_data is O::U::EDIReader hash
1012     # $provider is only a pkey
1013     # $message is Fieldmapper::acq::edi_message
1014
1015     my $e = new_editor();
1016
1017     my $log_prefix = "create_acq_invoice_from_edi(..., <acq.edi_message #" .
1018         $message->id . ">): ";
1019
1020     my %msg_kludges;
1021     if ($msg_data->{vendor_san}) {
1022         %msg_kludges = $class->get_kludges('INVOIC', $msg_data->{vendor_san});
1023     } else {
1024         $logger->warn($log_prefix . "no vendor_san field!");
1025     }
1026
1027     my $eg_inv = Fieldmapper::acq::invoice->new;
1028     $eg_inv->isnew(1);
1029
1030     # Some troubleshooting aids.  Yeah we should have made appropriate links
1031     # for this in the schema, but this is better than nothing.  Probably
1032     # *don't* try to i18n this.
1033     $eg_inv->note("Generated from acq.edi_message #" . $message->id . ".");
1034     if (%msg_kludges) {
1035         $eg_inv->note(
1036             $eg_inv->note .
1037             " Vendor kludges: " . join(", ", keys(%msg_kludges)) . "."
1038         );
1039     }
1040
1041     $eg_inv->provider($provider);
1042     $eg_inv->shipper($provider);    # XXX Do we really have a meaningful way to
1043                                     # distinguish provider and shipper?
1044     $eg_inv->recv_method("EDI");
1045
1046     $eg_inv->recv_date(
1047         $class->edi_date_to_iso($msg_data->{invoice_date}));
1048
1049
1050     $class->process_message_buyer($e, $msg_data, $message, $log_prefix, $eg_inv);
1051
1052     if (!$eg_inv->receiver) {
1053         die($log_prefix .
1054             sprintf("unable to determine buyer (org unit) in invoice; ".
1055                 "buyer_san=%s; buyer_acct=%s",
1056                 ($msg_data->{buyer_san} || ''),
1057                 ($msg_data->{buyer_acct} || '')
1058             )
1059         );
1060     }
1061
1062     $eg_inv->inv_ident($msg_data->{invoice_ident});
1063
1064     if (!$eg_inv->inv_ident) {
1065         die($log_prefix . "no invoice ID # in INVOIC message; " . shift);
1066     }
1067
1068     $message->purchase_order($msg_data->{purchase_order});
1069
1070     # Invoice lineitems should generally link to Evergreen lineitems
1071     # (with acq.invoice_entry rows), except when they don't refer to any
1072     # Evergreen lineitems by their known number. In that case, they're
1073     # probably things ordered not through the ILS. We don't have an
1074     # appropriate table for storing that kind of information right now,
1075     # so we skip those. No, we don't have enough information to create
1076     # Evergreen lineitems on the fly and create acqie rows linking to
1077     # those.
1078     my ($eg_inv_entries, $unknowns) = process_invoice_lineitems(
1079         $e, \%msg_kludges, $log_prefix, $message, $msg_data->{lineitems}
1080
1081     );
1082
1083     if (@$unknowns) {
1084         $logger->warn(
1085             $log_prefix . sprintf(
1086                 "skipped %d unknown lineitem reference(s) from EDI invoice: %s",
1087                 scalar(@$unknowns),
1088                 join("; ", map { "'$_'" } @$unknowns)
1089             )
1090         );
1091     }
1092
1093     my %charge_type_map = (
1094         'TX' => ['TAX', 'Tax from electronic invoice'],
1095         'CA' => ['PRO', 'Cataloging services'],
1096         'DL' => ['SHP', 'Delivery'],
1097         'GST' => ['TAX', 'Goods and services tax']
1098     ); # XXX i18n, somehow
1099
1100     my $eg_inv_items = [];
1101
1102     for my $charge (@{$msg_data->{misc_charges}}, @{$msg_data->{taxes}}) {
1103         my $eg_inv_item = Fieldmapper::acq::invoice_item->new;
1104         $eg_inv_item->isnew(1);
1105
1106         my $amount = $charge->{amount};
1107
1108         if (!$amount) {
1109             $logger->warn($log_prefix . "charge with no amount");
1110             next;
1111         }
1112
1113         my $map = $charge_type_map{$charge->{type}};
1114
1115         if (!$map) {
1116             $map = ['PRO', 'Misc / unspecified'];
1117             $eg_inv_item->note($charge->{type});
1118         }
1119
1120         $eg_inv_item->inv_item_type($$map[0]);
1121         $eg_inv_item->title($$map[1]);  # title is user-visible; note isn't.
1122         $eg_inv_item->cost_billed($amount);
1123         $eg_inv_item->amount_paid($amount);
1124
1125         push @$eg_inv_items, $eg_inv_item;
1126     }
1127
1128     $logger->info($log_prefix .
1129         sprintf("creating invoice with %d entries and %d items.",
1130             scalar(@$eg_inv_entries), scalar(@$eg_inv_items)));
1131
1132     $e->xact_begin;
1133
1134     # save changes to acq.edi_message row
1135     if (not $e->update_acq_edi_message($message)) {
1136         die($log_prefix . "couldn't update edi_message " . $message->id);
1137     }
1138
1139     my $result = OpenILS::Application::Acq::Invoice::build_invoice_impl(
1140         $e, $eg_inv, $eg_inv_entries, $eg_inv_items, 0   # don't commit yet
1141     );
1142
1143     if ($U->event_code($result)) {
1144         die($log_prefix. "build_invoice_impl() failed: " . $result->{textcode});
1145     }
1146
1147     $e->xact_commit;
1148     return 1;
1149 }
1150
1151 sub create_shipment_notification_from_edi {
1152     my ($class, $msg_data, $provider_id, $edi_message) = @_;
1153     # $msg_data is O::U::EDIReader hash
1154
1155     $logger->info("ASN: " . Dumper($msg_data));
1156
1157     my $e = new_editor();
1158
1159     # Uniqify the container codes
1160     my %containers = map {$_->{container_code} => 1} @{$msg_data->{lineitems}};
1161
1162     for my $container_code (keys %containers) {
1163
1164         next unless $container_code;
1165
1166         $logger->info("ACQ processing container: $container_code");
1167
1168         my $eg_asn = Fieldmapper::acq::shipment_notification->new;
1169         $eg_asn->isnew(1);
1170
1171         # Some troubleshooting aids.  Yeah we should have made appropriate links
1172         # for this in the schema, but this is better than nothing.  Probably
1173         # *don't* try to i18n this.
1174         $eg_asn->note("Generated from acq.edi_message #" . $edi_message->id . ".");
1175
1176         $eg_asn->provider($provider_id);
1177         $eg_asn->shipper($provider_id);
1178         $eg_asn->recv_method('EDI');
1179
1180         $eg_asn->recv_date( # invoice_date is a misnomer; should be message date.
1181             $class->edi_date_to_iso($msg_data->{invoice_date}));
1182
1183         $class->process_message_buyer($e, $msg_data, $edi_message, "ASN" , $eg_asn);
1184
1185         if (!$eg_asn->receiver) {
1186             die(sprintf(
1187                 "Unable to determine buyer (org unit) in shipment notification; ".
1188                 "buyer_san=%s; buyer_acct=%s",
1189                 ($msg_data->{buyer_san} || ''),
1190                 ($msg_data->{buyer_acct} || '')
1191             ));
1192         }
1193
1194         $eg_asn->container_code($container_code);
1195
1196         die("No container code in DESADV message") unless $eg_asn->container_code;
1197
1198         my $entries = extract_shipment_notification_entries([
1199             grep {$_->{container_code} eq $container_code} @{$msg_data->{lineitems}}]);
1200
1201         $e->xact_begin;
1202
1203         die "Error updating EDI message: " . $e->die_event
1204             unless $e->update_acq_edi_message($edi_message);
1205
1206         die "Error creating shipment notification: " . $e->die_event
1207             unless $e->create_acq_shipment_notification($eg_asn);
1208
1209         for my $entry (@$entries) {
1210             $entry->shipment_notification($eg_asn->id);
1211             die "Error creating shipment notification entry: " . $e->die_event
1212                 unless $e->create_acq_shipment_notification_entry($entry);
1213         }
1214
1215         $e->xact_commit;
1216     }
1217
1218     return 1;
1219 }
1220
1221 sub extract_shipment_notification_entries {
1222     my ($lineitem_hashes) = @_;
1223
1224     my $e = new_editor();
1225     my @entries;
1226     for my $li_hash (@$lineitem_hashes) {
1227
1228         # A shipment notification may cover multiple PO's.
1229         # Each LI will include its own PO ID.
1230         my $po_id = $li_hash->{purchase_order};
1231
1232         unless ($po_id) {
1233             $logger->warn("Skipping ASN lineitem which has no PO ID");
1234             next;
1235         }
1236
1237         my ($quant) = grep {$_->{code} eq '12'} @{$li_hash->{quantities}};
1238         my $quantity = ($quant) ? $quant->{quantity} : 0;
1239
1240         # LI identifiers map to order identifiers, not lineitem IDs,
1241         # at least not in the data seen so far.
1242         my $li_id;
1243         for my $ident_spec (@{$li_hash->{identifiers}}) {
1244
1245             my $ident = $ident_spec->{value};
1246             next unless $ident;
1247
1248             my $li_id_hash = $e->json_query({
1249                 select => {jub => ['id']},
1250                 from => {
1251                     jub => {
1252                         acqlia => {
1253                             filter => {
1254                                 order_ident => 't',
1255                                 attr_value => $ident
1256                             }
1257                         }
1258                     }
1259                 },
1260                 where => {'+jub' => {purchase_order => $po_id}}
1261             })->[0];
1262
1263             if ($li_id_hash) {
1264                 $li_id = $li_id_hash->{id};
1265                 last;
1266             } else {
1267                 $logger->warn("Cannot find lineitem with order ".
1268                     "identifier=$ident and purchase_order=$po_id");
1269             }
1270         }
1271
1272         unless ($li_id) {
1273             $logger->warn("Cannot find lineitem for ASN entry; skippping");
1274             next;
1275         }
1276
1277         my $entry = Fieldmapper::acq::shipment_notification_entry->new;
1278
1279         $entry->lineitem($li_id);
1280         $entry->item_count($quantity);
1281
1282         push(@entries, $entry);
1283     }
1284
1285     return \@entries;
1286 }
1287
1288 1;
1289