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::Utils::RemoteAccount;
  15 use OpenILS::Utils::CStoreEditor q/new_editor/;
  16 use OpenILS::Utils::Fieldmapper;
  17 use OpenILS::Application::Acq::EDI::Translator;
  18
  19 use OpenILS::Utils::EDIReader;
  20
  21 use Data::Dumper;
  22 our $verbose = 0;
  23
  24 sub new {
  25     my($class, %args) = @_;
  26     my $self = bless(\%args, $class);
  27     # $self->{args} = {};
  28     return $self;
  29 }
  30
  31 # our $reasons = {};   # cache for acq.cancel_reason rows ?
  32
  33 our $translator;
  34
  35 sub translator {
  36     return $translator ||= OpenILS::Application::Acq::EDI::Translator->new(@_);
  37 }
  38
  39 my %map = (
  40     host     => 'remote_host',
  41     username => 'remote_user',
  42     password => 'remote_password',
  43     account  => 'remote_account',
  44     # in_dir   => 'remote_path',   # field_map overrides path with in_dir
  45     path     => 'remote_path',
  46 );
  47
  48
  49 ## Just for debugging stuff:
  50 sub add_a_msg {
  51     my ($self, $conn) = @_;
  52     my $e = new_editor(xact=>1);
  53     my $incoming = Fieldmapper::acq::edi_message->new;
  54     $incoming->edi("This is content");
  55     $incoming->account(1);
  56     $incoming->remote_file('in/some_file.edi');
  57     $e->create_acq_edi_message($incoming);;
  58     $e->commit;
  59 }
  60 # __PACKAGE__->register_method( method => 'add_a_msg', api_name => 'open-ils.acq.edi.add_a_msg');  # debugging
  61
  62 __PACKAGE__->register_method(
  63         method    => 'retrieve',
  64         api_name  => 'open-ils.acq.edi.retrieve',
  65     authoritative => 1,
  66         signature => {
  67         desc   => 'Fetch incoming message(s) from EDI accounts.  ' .
  68                   'Optional arguments to restrict to one vendor and/or a max number of messages.  ' .
  69                   'Note that messages are not parsed or processed here, just fetched and translated.',
  70         params => [
  71             {desc => 'Authentication token',        type => 'string'},
  72             {desc => 'Vendor ID (undef for "all")', type => 'number'},
  73             {desc => 'Date Inactive Since',         type => 'string'},
  74             {desc => 'Max Messages Retrieved',      type => 'number'}
  75         ],
  76         return => {
  77             desc => 'List of new message IDs (empty if none)',
  78             type => 'array'
  79         }
  80     }
  81 );
  82
  83 sub retrieve_core {
  84     my ($self, $set, $max, $e, $test) = @_;    # $e is a working editor
  85
  86     $e   ||= new_editor();
  87     $set ||= __PACKAGE__->retrieve_vendors($e);
  88
  89     my @return = ();
  90     my $vcount = 0;
  91     foreach my $account (@$set) {
  92         my $count = 0;
  93         my $server;
  94         $logger->info("EDI check for vendor " . ++$vcount . " of " . scalar(@$set) . ": " . $account->host);
  95         unless ($server = __PACKAGE__->remote_account($account)) {   # assignment, not comparison
  96             $logger->err(sprintf "Failed remote account mapping for %s (%s)", $account->host, $account->id);
  97             next;
  98         };
  99 #       my $rf_starter = './';  # default to current dir
 100         if ($account->in_dir) {
 101             if ($account->in_dir =~ /\*+.*\//) {
 102                 $logger->err("EDI in_dir has a slash after an asterisk in value: '" . $account->in_dir . "'.  Skipping account with indeterminate target dir!");
 103                 next;
 104             }
 105 #           $rf_starter = $account->in_dir;
 106 #           $rf_starter =~ s/((\/)?[^\/]*)\*+[^\/]*$//;  # kill up to the first (possible) slash before the asterisk: keep the preceeding static dir
 107 #           $rf_starter .= '/' if $rf_starter or $2;   # recap the dir, or replace leading "/" if there was one (but don't add if empty)
 108         }
 109         my @files    = ($server->ls({remote_file => ($account->in_dir || './')}));
 110         my @ok_files = grep {$_ !~ /\/\.?\.$/ and $_ ne '0'} @files;
 111         $logger->info(sprintf "%s of %s files at %s/%s", scalar(@ok_files), scalar(@files), $account->host, $account->in_dir);
 112         # $server->remote_path(undef);
 113         foreach my $remote_file (@ok_files) {
 114             # my $remote_file = $rf_starter . $_;
 115             my $description = sprintf "%s/%s", $account->host, $remote_file;
 116
 117             # deduplicate vs. acct/filenames already in DB
 118             my $hits = $e->search_acq_edi_message([
 119                 {
 120                     account     => $account->id,
 121                     remote_file => $remote_file,
 122                     status      => {'in' => [qw/ processed /]},     # if it never got processed, go ahead and get the new one (try again)
 123                     # create_time => 'NOW() - 60 DAYS',     # if we wanted to allow filenames to be reused after a certain time
 124                     # ideally we would also use the date from FTP, but that info isn't available via RemoteAccount
 125                 }
 126                 # { flesh => 1, flesh_fields => {...}, }
 127             ]);
 128             if (scalar(@$hits)) {
 129                 $logger->debug("EDI: $remote_file already retrieved.  Skipping");
 130                 warn "EDI: $remote_file already retrieved.  Skipping";
 131                 next;
 132             }
 133
 134             ++$count;
 135             $max and $count > $max and last;
 136             $logger->info(sprintf "%s of %s targets: %s", $count, scalar(@ok_files), $description);
 137             print sprintf "%s of %s targets: %s\n", $count, scalar(@ok_files), $description;
 138             if ($test) {
 139                 push @return, "test_$count";
 140                 next;
 141             }
 142             my $content;
 143             my $io = IO::Scalar->new(\$content);
 144             unless ( $server->get({remote_file => $remote_file, local_file => $io}) ) {
 145                 $logger->error("(S)FTP get($description) failed");
 146                 next;
 147             }
 148             my $incoming = __PACKAGE__->process_retrieval($content, $remote_file, $server, $account->id);
 149 #           $server->delete(remote_file => $_);   # delete remote copies of saved message
 150             push @return, @$incoming;
 151         }
 152     }
 153     return \@return;
 154 }
 155
 156 # my $msg_ids = OpenILS::Application::Acq::EDI->process_retrieval(
 157 #   $file_content, $remote_filename, $server, $account_id, $editor);
 158
 159 sub process_retrieval {
 160     my ($class, $content, $filename, $server, $account_or_id) = @_;
 161     $content or return;
 162
 163     my $e = new_editor;
 164     my $account = __PACKAGE__->record_activity($account_or_id, $e);
 165
 166     # a single EDI blob can contain multiple messages
 167     # create one edi_message per included message
 168
 169     my $messages = OpenILS::Utils::EDIReader->new->read($content);
 170     my @return;
 171
 172     for my $msg_hash (@$messages) {
 173
 174         my $incoming = Fieldmapper::acq::edi_message->new;
 175
 176         $incoming->remote_file($filename);
 177         $incoming->account($account->id);
 178         $incoming->edi($content);
 179         $incoming->message_type($msg_hash->{message_type});
 180         $incoming->jedi(OpenSRF::Utils::JSON->perl2JSON($msg_hash)); # jedi-2.0
 181         $incoming->status('translated');
 182         $incoming->translate_time('NOW');
 183
 184         if ($msg_hash->{purchase_order}) {
 185             $logger->info("EDI: processing message for PO " . $msg_hash->{purchase_order});
 186             $incoming->purchase_order($msg_hash->{purchase_order});
 187             unless ($e->retrieve_acq_purchase_order($incoming->purchase_order)) {
 188                 $logger->warn("EDI: received order response for nonexistent PO.  Skipping...");
 189                 next;
 190             }
 191         }
 192
 193         $e->xact_begin;
 194         unless($e->create_acq_edi_message($incoming)) {
 195             $logger->error("EDI: unable to create edi_message " . $e->die_event);
 196             next;
 197         }
 198         # refresh to pickup create_date, etc.
 199         $incoming = $e->retrieve_acq_edi_message($incoming->id);
 200         $e->xact_commit;
 201
 202         # since there's a fair chance of unhandled problems
 203         # cropping up, particularly with new vendors, wrap w/ eval.
 204         eval { $class->process_parsed_msg($account, $incoming, $msg_hash) };
 205
 206         $e->xact_begin;
 207         $incoming = $e->retrieve_acq_edi_message($incoming->id);
 208         if ($@) {
 209             $incoming->status('proc_error');
 210             $incoming->error($@);
 211         } else {
 212             $incoming->status('processed');
 213         }
 214         $e->update_acq_edi_message($incoming);
 215         $e->xact_commit;
 216
 217         push(@return, $incoming->id);
 218     }
 219
 220     return \@return;
 221 }
 222
 223 # ->send_core
 224 # $account     is a Fieldmapper object for acq.edi_account row
 225 # $messageset  is an arrayref with acq.edi_message.id values
 226 # $e           is optional editor object
 227 sub send_core {
 228     my ($class, $account, $message_ids, $e) = @_;    # $e is a working editor
 229
 230     ($account and scalar @$message_ids) or return;
 231     $e ||= new_editor();
 232
 233     $e->xact_begin;
 234     my @messageset = map {$e->retrieve_acq_edi_message($_)} @$message_ids;
 235     $e->xact_rollback;
 236     my $m_count = scalar(@messageset);
 237     (scalar(@$message_ids) == $m_count) or
 238         $logger->warn(scalar(@$message_ids) - $m_count . " bad IDs passed to send_core (ignored)");
 239
 240     my $log_str = sprintf "EDI send to edi_account %s (%s)", $account->id, $account->host;
 241     $logger->info("$log_str: $m_count message(s)");
 242     $m_count or return;
 243
 244     my $server;
 245     my $server_error;
 246     unless ($server = __PACKAGE__->remote_account($account, 1)) {   # assignment, not comparison
 247         $logger->error("Failed remote account connection for $log_str");
 248         $server_error = 1;
 249     };
 250     foreach (@messageset) {
 251         $_ or next;     # we already warned about bum ids
 252         my ($res, $error);
 253         if ($server_error) {
 254             $error = "Server error: Failed remote account connection for $log_str"; # already told $logger, this is to update object below
 255         } elsif (! $_->edi) {
 256             $logger->error("Message (id " . $_->id. ") for $log_str has no EDI content");
 257             $error = "EDI empty!";
 258         } elsif ($res = $server->put({remote_path => $account->path, content => $_->edi, single_ext => 1})) {
 259             #  This is the successful case!
 260             $_->remote_file($res);
 261             $_->status('complete');
 262             $_->process_time('NOW');    # For outbound files, sending is the end of processing on the EG side.
 263             $logger->info("Sent message (id " . $_->id. ") via $log_str");
 264         } else {
 265             $logger->error("(S)FTP put to $log_str FAILED: " . ($server->error || 'UNKOWNN'));
 266             $error = "put FAILED: " . ($server->error || 'UNKOWNN');
 267         }
 268         if ($error) {
 269             $_->error($error);
 270             $_->error_time('NOW');
 271         }
 272         $logger->info("Calling update_acq_edi_message");
 273         $e->xact_begin;
 274         unless ($e->update_acq_edi_message($_)) {
 275              $logger->error("EDI send_core update_acq_edi_message failed for message object: " . Dumper($_));
 276              OpenILS::Application::Acq::EDI::Translator->debug_file(Dumper($_              ), '/tmp/update_acq_edi_message.FAIL');
 277              OpenILS::Application::Acq::EDI::Translator->debug_file(Dumper($_->to_bare_hash), '/tmp/update_acq_edi_message.FAIL.to_bare_hash');
 278         }
 279         # There's always an update, even if we failed.
 280         $e->xact_commit;
 281         __PACKAGE__->record_activity($account, $e);  # There's always an update, even if we failed.
 282     }
 283     return \@messageset;
 284 }
 285
 286 #  attempt_translation does not touch the DB, just the object.
 287 sub attempt_translation {
 288     my ($class, $edi_message, $to_edi) = @_;
 289     my $tran  = translator();
 290     my $ret   = $to_edi ? $tran->json2edi($edi_message->jedi) : $tran->edi2json($edi_message->edi);
 291 #   $logger->error("json: " . Dumper($json)); # debugging
 292
 293     if (not $ret or (! ref($ret)) or $ret->is_fault) {      # RPC::XML::fault on failure
 294         $edi_message->status('trans_error');
 295         $edi_message->error_time('NOW');
 296         my $pre = "EDI Translator " . ($to_edi ? 'json2edi' : 'edi2json') . " failed";
 297         my $message = ref($ret) ?
 298                       ("$pre, Error " . $ret->code . ": " . __PACKAGE__->nice_string($ret->string)) :
 299                       ("$pre: "                           . __PACKAGE__->nice_string($ret)        ) ;
 300         $edi_message->error($message);
 301         $logger->error($message);
 302         return;
 303     }
 304
 305     $edi_message->status('translated');
 306     $edi_message->translate_time('NOW');
 307
 308     if ($to_edi) {
 309         $edi_message->edi($ret->value);    # translator returns an object
 310     } else {
 311         $edi_message->jedi($ret->value);   # translator returns an object
 312     }
 313     return $edi_message;
 314 }
 315
 316 sub retrieve_vendors {
 317     my ($self, $e, $vendor_id, $last_activity) = @_;    # $e is a working editor
 318
 319     $e ||= new_editor();
 320
 321     my $criteria = {'+acqpro' => {active => 't'}};
 322     $criteria->{'+acqpro'}->{id} = $vendor_id if $vendor_id;
 323     return $e->search_acq_edi_account([
 324         $criteria, {
 325             'join' => 'acqpro',
 326             flesh => 1,
 327             flesh_fields => {
 328                 acqedi => ['provider']
 329             }
 330         }
 331     ]);
 332 #   {"id":{"!=":null},"+acqpro":{"active":"t"}}, {"join":"acqpro", "flesh_fields":{"acqedi":["provider"]},"flesh":1}
 333 }
 334
 335 # This is the SRF-exposed call, so it does checkauth
 336
 337 sub retrieve {
 338     my ($self, $conn, $auth, $vendor_id, $last_activity, $max) = @_;
 339
 340     my $e = new_editor(authtoken=>$auth);
 341     unless ($e and $e->checkauth()) {
 342         $logger->warn("checkauth failed for authtoken '$auth'");
 343         return ();
 344     }
 345     # return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency);  # add permission here ?
 346
 347     my $set = __PACKAGE__->retrieve_vendors($e, $vendor_id, $last_activity) or return $e->die_event;
 348     return __PACKAGE__->retrieve_core($e, $set, $max);
 349 }
 350
 351
 352 # field_map takes the hashref of vendor data with fields from acq.edi_account and
 353 # maps them to the argument style needed for RemoteAccount.  It also extrapolates
 354 # data from the remote_host string for type and port, when available.
 355
 356 sub field_map {
 357     my $self   = shift;
 358     my $vendor = shift or return;
 359     my $no_override = @_ ? shift : 0;
 360     my %args = ();
 361     $verbose and $logger->warn("vendor: " . Dumper($vendor));
 362     foreach (keys %map) {
 363         $args{$map{$_}} = $vendor->$_ if defined $vendor->$_;
 364     }
 365     unless ($no_override) {
 366         $args{remote_path} = $vendor->in_dir;    # override "path" with "in_dir"
 367     }
 368     my $host = $args{remote_host} || '';
 369     ($host =~ s/^(S?FTP)://i    and $args{type} = uc($1)) or
 370     ($host =~ s/^(SSH|SCP)://i  and $args{type} = 'SCP' ) ;
 371      $host =~ s/:(\d+)$//       and $args{port} = $1;
 372     ($args{remote_host} = $host) =~ s#/+##;
 373     $verbose and $logger->warn("field_map: " . Dumper(\%args));
 374     return %args;
 375 }
 376
 377
 378 # The point of remote_account is to get the RemoteAccount object with args from the DB
 379
 380 sub remote_account {
 381     my ($self, $vendor, $outbound, $e) = @_;
 382
 383     unless (ref($vendor)) {     # It's not a hashref/object.
 384         $vendor or return;      # If in fact it's nothing: abort!
 385                                 # else it's a vendor_id string, so get the full vendor data
 386         $e ||= new_editor();
 387         my $set_of_one = $self->retrieve_vendors($e, $vendor) or return;
 388         $vendor = shift @$set_of_one;
 389     }
 390
 391     return OpenILS::Utils::RemoteAccount->new(
 392         $self->field_map($vendor, $outbound)
 393     );
 394 }
 395
 396 # takes account ID or account Fieldmapper object
 397
 398 sub record_activity {
 399     my ($class, $account_or_id, $e) = @_;
 400     $account_or_id or return;
 401     $e ||= new_editor();
 402     my $account = ref($account_or_id) ? $account_or_id : $e->retrieve_acq_edi_account($account_or_id);
 403     $logger->info("EDI record_activity calling update_acq_edi_account");
 404     $account->last_activity('NOW') or return;
 405     $e->xact_begin;
 406     $e->update_acq_edi_account($account) or $logger->warn("EDI: in record_activity, update_acq_edi_account FAILED");
 407     $e->xact_commit;
 408     return $account;
 409 }
 410
 411 sub nice_string {
 412     my $class = shift;
 413     my $string = shift or return '';
 414     chomp($string);
 415     my $head   = @_ ? shift : 100;
 416     my $tail   = @_ ? shift :  25;
 417     (length($string) < $head + $tail) and return $string;
 418     my $h = substr($string,0,$head);
 419     my $t = substr($string, -1*$tail);
 420     $h =~s/\s*$//o;
 421     $t =~s/\s*$//o;
 422     return "$h ... $t";
 423     # return substr($string,0,$head) . "... " . substr($string, -1*$tail);
 424 }
 425
 426 # parts of this process can fail without the entire
 427 # thing failing.  If a catastrophic error occurs,
 428 # it will occur via die.
 429 sub process_parsed_msg {
 430     my ($class, $account, $incoming, $msg_hash) = @_;
 431
 432     if ($incoming->message_type eq 'INVOIC') {
 433         return $class->create_acq_invoice_from_edi(
 434             $msg_hash, $account->provider, $incoming);
 435     }
 436
 437     # ORDRSP
 438     for my $li_hash (@{$msg_hash->{lineitems}}) {
 439         my $e = new_editor(xact => 1);
 440
 441         my $li_id = $li_hash->{id};
 442         my $li = $e->retrieve_acq_lineitem($li_id);
 443
 444         if (!$li) {
 445             $logger->error("EDI: reqest for invalid lineitem ID '$li_id'");
 446             $e->rollback;
 447             next;
 448         }
 449
 450         if ($li_hash->{expected_date}) {
 451             my ($y, $m, $d) = $li_hash->{expected_date} =~ /^(\d{4})(\d{2})(\d{2})/g;
 452             my $recv_time = $y;
 453             $recv_time .= "-$m" if $m;
 454             $recv_time .= "-$d" if $d;
 455             $li->expected_recv_time($recv_time);
 456         }
 457
 458         $li->estimated_unit_price($li_hash->{unit_price});
 459
 460         if (not $incoming->purchase_order) {
 461             # PO should come from the EDI message, but if not...
 462
 463             # fetch the latest copy
 464             $incoming = $e->retrieve_acq_edi_message($incoming->id);
 465             $incoming->purchase_order($li->purchase_order);
 466
 467             unless($e->update_acq_edi_message($incoming)) {
 468                 $logger->error("EDI: unable to update edi_message " . $e->die_event);
 469                 next;
 470             }
 471         }
 472
 473         my $lids = $e->json_query({
 474             select => {acqlid => ['id']},
 475             from => 'acqlid',
 476             where => { lineitem => $li->id }
 477         });
 478
 479         my @lids = map { $_->{id} } @$lids;
 480         my $lid_count = scalar(@lids);
 481         my $lids_covered = 0;
 482         my $lids_touched = 0;
 483
 484         for my $qty (@{$li_hash->{quantities}}) {
 485
 486             my $qty_count = $qty->{quantity} or next;
 487             my $qty_code = $qty->{code};
 488
 489             if (!$qty_code) {
 490                 $logger->warn("EDI: Response for LI $li_id specifies quantity ".
 491                     "$qty_count with no 6063 code! Contact vendor to resolve.");
 492                 next;
 493             }
 494
 495             $logger->info("EDI: LI $li_id processing quantity count=$qty_count / code=$qty_code");
 496
 497             if ($qty_code eq '21') { # "ordered quantity"
 498                 $logger->info("EDI: LI $li_id -- vendor confirms $qty_count ordered");
 499                 $logger->warn("EDI: LI $li_id -- order count $qty_count ".
 500                     "does not match LID count $lid_count") unless $qty_count == $lid_count;
 501                 next;
 502             }
 503
 504             $lids_covered += $qty_count;
 505
 506             if ($qty_code eq '12') {
 507                 $logger->info("EDI: LI $li_id -- vendor dispatched $qty_count");
 508                 next;
 509
 510             } elsif ($qty_code eq '57') {
 511                 $logger->info("EDI: LI $li_id -- $qty_count in transit");
 512                 next;
 513             }
 514             # 84: urgent delivery
 515             # 118: quantity manifested
 516             # ...
 517
 518             # -------------------------------------------------------------------------
 519             # All of the remaining quantity types require that we apply a cancel_reason
 520             # DB populated w/ 6063 keys in 1200's
 521
 522             my $eg_reason = $e->retrieve_acq_cancel_reason(1200 + $qty_code);
 523
 524             if (!$eg_reason) {
 525                 $logger->warn("EDI: Unhandled quantity qty_code '$qty_code' ".
 526                     "for li $li_id.  $qty_count items unprocessed");
 527                 next;
 528             }
 529
 530             my $break = 0;
 531             foreach (1 .. $qty_count) {
 532
 533                 my $lid_id = shift @lids;
 534                 if (!$lid_id) {
 535                     $logger->warn("EDI: Used up all $lid_count LIDs. ".
 536                         "Ignoring extra status '" . $eg_reason->label . "'");
 537                     last;
 538                 }
 539
 540                 my $lid = $e->retrieve_acq_lineitem_detail($lid_id);
 541                 $lid->cancel_reason($eg_reason->id);
 542                 $e->update_acq_lineitem_detail($lid);
 543                 $lids_touched++;
 544
 545                 # if ALL the items have the same cancel_reason, the LI gets it too
 546                 $li->cancel_reason($eg_reason->id) if $qty_count == $lid_count;
 547
 548                 $li->edit_time('now');
 549                 unless ($e->update_acq_lineitem($li)) {
 550                     $logger->error("EDI: update_acq_lineitem failed " . $e->die_event);
 551                     $break = 1;
 552                     last;
 553                 }
 554             }
 555
 556             # non-recoverable transaction error
 557             # note in this case the commit below will be a silent no-op
 558             last if $break;
 559         }
 560
 561         # LI and LIDs updated, let's wrap this one up.
 562         $e->commit;
 563
 564         $logger->info("EDI LI $li_id -- $lids_covered LIDs mentioned; ".
 565             "$lids_touched LIDs had cancel_reason's applied");
 566     }
 567 }
 568
 569
 570 # create_acq_invoice_from_edi() does what it sounds like it does for INVOIC
 571 # messages.  For similar operation on ORDRSP messages, see the guts of
 572 # process_jedi().
 573 # Return boolean success indicator.
 574 sub create_acq_invoice_from_edi {
 575     my ($class, $invoice, $provider, $message) = @_;
 576     # $invoice is O::U::EDIReader hash
 577     # $provider is only a pkey
 578     # $message is Fieldmapper::acq::edi_message
 579
 580     my $e = new_editor();
 581
 582     my $log_prefix = "create_acq_invoice_from_edi(..., <acq.edi_message #" .
 583         $message->id . ">): ";
 584
 585     my $eg_inv = Fieldmapper::acq::invoice->new;
 586
 587     $eg_inv->provider($provider);
 588     $eg_inv->shipper($provider);    # XXX Do we really have a meaningful way to
 589                                     # distinguish provider and shipper?
 590     $eg_inv->recv_method("EDI");
 591
 592
 593     # some vendors encode the account number as the SAN.
 594     # starting with the san value, then the account value,
 595     # treat each as a san, then an acct number until the first success
 596     for my $buyer ( ($invoice->{buyer_san}, $invoice->{buyer_acct}) ) {
 597         next unless $buyer;
 598
 599         # some vendors encode the SAN as "$SAN $vendcode"
 600         $buyer =~ s/\s.*//g;
 601
 602         my $addr = $e->search_actor_org_address(
 603             {valid => "t", san => $buyer})->[0];
 604
 605         if ($addr) {
 606
 607             $eg_inv->receiver($addr->org_unit);
 608             last;
 609
 610         } else {
 611
 612             my $acct = $e->search_acq_edi_account({vendacct => $buyer})->[0];
 613
 614             if ($acct) {
 615                 $eg_inv->receiver($acct->owner);
 616                 last;
 617             }
 618         }
 619     }
 620
 621     if (!$eg_inv->receiver) {
 622         $logger->error($log_prefix .
 623             sprintf("unable to determine buyer (org unit) in invoice; ".
 624                 "buyer_san=%s; buyer_acct=%s",
 625                 ($invoice->{buyer_san} || ''),
 626                 ($invoice->{buyer_acct} || '')
 627             )
 628         );
 629         return 0;
 630     }
 631
 632     $eg_inv->inv_ident($invoice->{invoice_ident});
 633
 634     if (!$eg_inv->inv_ident) {
 635         $logger->error(
 636             $log_prefix . "no invoice ID # in INVOIC message; " . shift
 637         );
 638         return 0;
 639     }
 640
 641     my @eg_inv_entries;
 642
 643     $message->purchase_order($invoice->{purchase_order});
 644
 645     for my $lineitem (@{$invoice->{lineitems}}) {
 646         my $li_id = $lineitem->{id};
 647
 648         if (!$li_id) {
 649             $logger->warn($log_prefix . "no lineitem ID");
 650             next;
 651         }
 652
 653         my $li = $e->retrieve_acq_lineitem($li_id);
 654
 655         if (!$li) {
 656             $logger->warn($log_prefix .
 657                 "no LI found with ID: $li_id : " . $e->event);
 658             return 0;
 659         }
 660
 661         my ($quant) = grep {$_->{code} eq '47'} @{$lineitem->{quantities}};
 662         my $quantity = ($quant) ? $quant->{quantity} : 0;
 663
 664         if (!$quantity) {
 665             $logger->warn($log_prefix .
 666                 "no invoice quantity specified for LI $li_id");
 667             next;
 668         }
 669
 670         # NOTE: if needed, we also have $lineitem->{net_unit_price}
 671         # and $lineitem->{gross_unit_price}
 672         my $lineitem_price = $lineitem->{amount_billed};
 673
 674         # if the top-level PO value is unset, get it from the first LI
 675         $message->purchase_order($li->purchase_order)
 676             unless $message->purchase_order;
 677
 678         my $eg_inv_entry = Fieldmapper::acq::invoice_entry->new;
 679         $eg_inv_entry->inv_item_count($quantity);
 680
 681         # XXX Validate by making sure the LI is on-order and belongs to
 682         # the right provider and ordering agency and all that.
 683         $eg_inv_entry->lineitem($li_id);
 684
 685         # XXX Do we actually need to link to PO directly here?
 686         $eg_inv_entry->purchase_order($li->purchase_order);
 687
 688         # This is the total price for all units billed, not per-unit.
 689         $eg_inv_entry->cost_billed($lineitem_price);
 690
 691         push @eg_inv_entries, $eg_inv_entry;
 692     }
 693
 694     my @eg_inv_items;
 695
 696     my %charge_type_map = (
 697         'TX' => ['TAX', 'Tax from electronic invoice'],
 698         'CA' => ['PRO', 'Cataloging services'],
 699         'DL' => ['SHP', 'Delivery']
 700     );
 701
 702     for my $charge (@{$invoice->{misc_charges}}) {
 703         my $eg_inv_item = Fieldmapper::acq::invoice_item->new;
 704
 705         my $amount = $charge->{charge_amount};
 706
 707         if (!$amount) {
 708             $logger->warn($log_prefix . "charge with no amount");
 709             next;
 710         }
 711
 712         my $map = $charge_type_map{$charge->{charge_type}};
 713
 714         if (!$map) {
 715             $map = [
 716                 'PRO',
 717                 'Unknown charge type ' .  $charge->{charge_type}
 718             ];
 719         }
 720
 721         $eg_inv_item->inv_item_type($$map[0]);
 722         $eg_inv_item->note($$map[1]);
 723         $eg_inv_item->cost_billed($amount);
 724
 725         push @eg_inv_items, $eg_inv_item;
 726     }
 727
 728     $logger->info($log_prefix .
 729         sprintf("creating invoice with %d entries and %d items.",
 730             scalar(@eg_inv_entries), scalar(@eg_inv_items)));
 731
 732     $e->xact_begin;
 733
 734     # save changes to acq.edi_message row
 735     if (not $e->update_acq_edi_message($message)) {
 736         $logger->error(
 737             $log_prefix . "couldn't update edi_message " . $message->id
 738         );
 739         return 0;
 740     }
 741
 742     # create EG invoice
 743     if (not $e->create_acq_invoice($eg_inv)) {
 744         $logger->error($log_prefix . "couldn't create invoice: " . $e->event);
 745         return 0;
 746     }
 747
 748     # Now we have a pkey for our EG invoice, so set the invoice field on all
 749     # our entries according and create those too.
 750     my $eg_inv_id = $e->data->id;
 751     foreach (@eg_inv_entries) {
 752         $_->invoice($eg_inv_id);
 753         if (not $e->create_acq_invoice_entry($_)) {
 754             $logger->error(
 755                 $log_prefix . "couldn't create entry against lineitem " .
 756                 $_->lineitem . ": " . $e->event
 757             );
 758             return 0;
 759         }
 760     }
 761
 762     # Create any invoice items (taxes)
 763     foreach (@eg_inv_items) {
 764         $_->invoice($eg_inv_id);
 765         if (not $e->create_acq_invoice_item($_)) {
 766             $logger->error(
 767                 $log_prefix . "couldn't create inv item: " . $e->event
 768             );
 769             return 0;
 770         }
 771     }
 772
 773     $e->xact_commit;
 774     return 1;
 775 }
 776
 777 1;
 778