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