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         }
 188
 189         $e->xact_begin;
 190         unless($e->create_acq_edi_message($incoming)) {
 191             $logger->error("EDI: unable to create edi_message " . $e->die_event);
 192             next;
 193         }
 194         # refresh to pickup create_date, etc.
 195         $incoming = $e->retrieve_acq_edi_message($incoming->id);
 196         $e->xact_commit;
 197
 198         # since there's a fair chance of unhandled problems
 199         # cropping up, particularly with new vendors, wrap w/ eval.
 200         eval { $class->process_parsed_msg($account, $incoming, $msg_hash) };
 201
 202         $e->xact_begin;
 203         $incoming = $e->retrieve_acq_edi_message($incoming->id);
 204         if ($@) {
 205             $incoming->status('proc_error');
 206             $incoming->error($@);
 207         } else {
 208             $incoming->status('processed');
 209         }
 210         $e->update_acq_edi_message($incoming);
 211         $e->xact_commit;
 212
 213         push(@return, $incoming->id);
 214     }
 215
 216     return \@return;
 217 }
 218
 219 # ->send_core
 220 # $account     is a Fieldmapper object for acq.edi_account row
 221 # $messageset  is an arrayref with acq.edi_message.id values
 222 # $e           is optional editor object
 223 sub send_core {
 224     my ($class, $account, $message_ids, $e) = @_;    # $e is a working editor
 225
 226     ($account and scalar @$message_ids) or return;
 227     $e ||= new_editor();
 228
 229     $e->xact_begin;
 230     my @messageset = map {$e->retrieve_acq_edi_message($_)} @$message_ids;
 231     $e->xact_rollback;
 232     my $m_count = scalar(@messageset);
 233     (scalar(@$message_ids) == $m_count) or
 234         $logger->warn(scalar(@$message_ids) - $m_count . " bad IDs passed to send_core (ignored)");
 235
 236     my $log_str = sprintf "EDI send to edi_account %s (%s)", $account->id, $account->host;
 237     $logger->info("$log_str: $m_count message(s)");
 238     $m_count or return;
 239
 240     my $server;
 241     my $server_error;
 242     unless ($server = __PACKAGE__->remote_account($account, 1)) {   # assignment, not comparison
 243         $logger->error("Failed remote account connection for $log_str");
 244         $server_error = 1;
 245     };
 246     foreach (@messageset) {
 247         $_ or next;     # we already warned about bum ids
 248         my ($res, $error);
 249         if ($server_error) {
 250             $error = "Server error: Failed remote account connection for $log_str"; # already told $logger, this is to update object below
 251         } elsif (! $_->edi) {
 252             $logger->error("Message (id " . $_->id. ") for $log_str has no EDI content");
 253             $error = "EDI empty!";
 254         } elsif ($res = $server->put({remote_path => $account->path, content => $_->edi, single_ext => 1})) {
 255             #  This is the successful case!
 256             $_->remote_file($res);
 257             $_->status('complete');
 258             $_->process_time('NOW');    # For outbound files, sending is the end of processing on the EG side.
 259             $logger->info("Sent message (id " . $_->id. ") via $log_str");
 260         } else {
 261             $logger->error("(S)FTP put to $log_str FAILED: " . ($server->error || 'UNKOWNN'));
 262             $error = "put FAILED: " . ($server->error || 'UNKOWNN');
 263         }
 264         if ($error) {
 265             $_->error($error);
 266             $_->error_time('NOW');
 267         }
 268         $logger->info("Calling update_acq_edi_message");
 269         $e->xact_begin;
 270         unless ($e->update_acq_edi_message($_)) {
 271              $logger->error("EDI send_core update_acq_edi_message failed for message object: " . Dumper($_));
 272              OpenILS::Application::Acq::EDI::Translator->debug_file(Dumper($_              ), '/tmp/update_acq_edi_message.FAIL');
 273              OpenILS::Application::Acq::EDI::Translator->debug_file(Dumper($_->to_bare_hash), '/tmp/update_acq_edi_message.FAIL.to_bare_hash');
 274         }
 275         # There's always an update, even if we failed.
 276         $e->xact_commit;
 277         __PACKAGE__->record_activity($account, $e);  # There's always an update, even if we failed.
 278     }
 279     return \@messageset;
 280 }
 281
 282 #  attempt_translation does not touch the DB, just the object.
 283 sub attempt_translation {
 284     my ($class, $edi_message, $to_edi) = @_;
 285     my $tran  = translator();
 286     my $ret   = $to_edi ? $tran->json2edi($edi_message->jedi) : $tran->edi2json($edi_message->edi);
 287 #   $logger->error("json: " . Dumper($json)); # debugging
 288
 289     if (not $ret or (! ref($ret)) or $ret->is_fault) {      # RPC::XML::fault on failure
 290         $edi_message->status('trans_error');
 291         $edi_message->error_time('NOW');
 292         my $pre = "EDI Translator " . ($to_edi ? 'json2edi' : 'edi2json') . " failed";
 293         my $message = ref($ret) ?
 294                       ("$pre, Error " . $ret->code . ": " . __PACKAGE__->nice_string($ret->string)) :
 295                       ("$pre: "                           . __PACKAGE__->nice_string($ret)        ) ;
 296         $edi_message->error($message);
 297         $logger->error($message);
 298         return;
 299     }
 300
 301     $edi_message->status('translated');
 302     $edi_message->translate_time('NOW');
 303
 304     if ($to_edi) {
 305         $edi_message->edi($ret->value);    # translator returns an object
 306     } else {
 307         $edi_message->jedi($ret->value);   # translator returns an object
 308     }
 309     return $edi_message;
 310 }
 311
 312 sub retrieve_vendors {
 313     my ($self, $e, $vendor_id, $last_activity) = @_;    # $e is a working editor
 314
 315     $e ||= new_editor();
 316
 317     my $criteria = {'+acqpro' => {active => 't'}};
 318     $criteria->{'+acqpro'}->{id} = $vendor_id if $vendor_id;
 319     return $e->search_acq_edi_account([
 320         $criteria, {
 321             'join' => 'acqpro',
 322             flesh => 1,
 323             flesh_fields => {
 324                 acqedi => ['provider']
 325             }
 326         }
 327     ]);
 328 #   {"id":{"!=":null},"+acqpro":{"active":"t"}}, {"join":"acqpro", "flesh_fields":{"acqedi":["provider"]},"flesh":1}
 329 }
 330
 331 # This is the SRF-exposed call, so it does checkauth
 332
 333 sub retrieve {
 334     my ($self, $conn, $auth, $vendor_id, $last_activity, $max) = @_;
 335
 336     my $e = new_editor(authtoken=>$auth);
 337     unless ($e and $e->checkauth()) {
 338         $logger->warn("checkauth failed for authtoken '$auth'");
 339         return ();
 340     }
 341     # return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency);  # add permission here ?
 342
 343     my $set = __PACKAGE__->retrieve_vendors($e, $vendor_id, $last_activity) or return $e->die_event;
 344     return __PACKAGE__->retrieve_core($e, $set, $max);
 345 }
 346
 347
 348 # field_map takes the hashref of vendor data with fields from acq.edi_account and
 349 # maps them to the argument style needed for RemoteAccount.  It also extrapolates
 350 # data from the remote_host string for type and port, when available.
 351
 352 sub field_map {
 353     my $self   = shift;
 354     my $vendor = shift or return;
 355     my $no_override = @_ ? shift : 0;
 356     my %args = ();
 357     $verbose and $logger->warn("vendor: " . Dumper($vendor));
 358     foreach (keys %map) {
 359         $args{$map{$_}} = $vendor->$_ if defined $vendor->$_;
 360     }
 361     unless ($no_override) {
 362         $args{remote_path} = $vendor->in_dir;    # override "path" with "in_dir"
 363     }
 364     my $host = $args{remote_host} || '';
 365     ($host =~ s/^(S?FTP)://i    and $args{type} = uc($1)) or
 366     ($host =~ s/^(SSH|SCP)://i  and $args{type} = 'SCP' ) ;
 367      $host =~ s/:(\d+)$//       and $args{port} = $1;
 368     ($args{remote_host} = $host) =~ s#/+##;
 369     $verbose and $logger->warn("field_map: " . Dumper(\%args));
 370     return %args;
 371 }
 372
 373
 374 # The point of remote_account is to get the RemoteAccount object with args from the DB
 375
 376 sub remote_account {
 377     my ($self, $vendor, $outbound, $e) = @_;
 378
 379     unless (ref($vendor)) {     # It's not a hashref/object.
 380         $vendor or return;      # If in fact it's nothing: abort!
 381                                 # else it's a vendor_id string, so get the full vendor data
 382         $e ||= new_editor();
 383         my $set_of_one = $self->retrieve_vendors($e, $vendor) or return;
 384         $vendor = shift @$set_of_one;
 385     }
 386
 387     return OpenILS::Utils::RemoteAccount->new(
 388         $self->field_map($vendor, $outbound)
 389     );
 390 }
 391
 392 # takes account ID or account Fieldmapper object
 393
 394 sub record_activity {
 395     my ($class, $account_or_id, $e) = @_;
 396     $account_or_id or return;
 397     $e ||= new_editor();
 398     my $account = ref($account_or_id) ? $account_or_id : $e->retrieve_acq_edi_account($account_or_id);
 399     $logger->info("EDI record_activity calling update_acq_edi_account");
 400     $account->last_activity('NOW') or return;
 401     $e->xact_begin;
 402     $e->update_acq_edi_account($account) or $logger->warn("EDI: in record_activity, update_acq_edi_account FAILED");
 403     $e->xact_commit;
 404     return $account;
 405 }
 406
 407 sub nice_string {
 408     my $class = shift;
 409     my $string = shift or return '';
 410     chomp($string);
 411     my $head   = @_ ? shift : 100;
 412     my $tail   = @_ ? shift :  25;
 413     (length($string) < $head + $tail) and return $string;
 414     my $h = substr($string,0,$head);
 415     my $t = substr($string, -1*$tail);
 416     $h =~s/\s*$//o;
 417     $t =~s/\s*$//o;
 418     return "$h ... $t";
 419     # return substr($string,0,$head) . "... " . substr($string, -1*$tail);
 420 }
 421
 422 # parts of this process can fail without the entire
 423 # thing failing.  If a catastrophic error occurs,
 424 # it will occur via die.
 425 sub process_parsed_msg {
 426     my ($class, $account, $incoming, $msg_hash) = @_;
 427
 428     if ($incoming->message_type eq 'INVOIC') {
 429         return $class->create_acq_invoice_from_edi(
 430             $msg_hash, $account->provider, $incoming);
 431     }
 432
 433     # ORDRSP
 434     for my $li_hash (@{$msg_hash->{lineitems}}) {
 435         my $e = new_editor(xact => 1);
 436
 437         my $li_id = $li_hash->{id};
 438         my $li = $e->retrieve_acq_lineitem($li_id);
 439
 440         if (!$li) {
 441             $logger->error("EDI: reqest for invalid lineitem ID '$li_id'");
 442             $e->rollback;
 443             next;
 444         }
 445
 446         if ($li_hash->{expected_date}) {
 447             my ($y, $m, $d) = $li_hash->{expected_date} =~ /^(\d{4})(\d{2})(\d{2})/g;
 448             my $recv_time = $y;
 449             $recv_time .= "-$m" if $m;
 450             $recv_time .= "-$d" if $d;
 451             $li->expected_recv_time($recv_time);
 452         }
 453
 454         $li->estimated_unit_price($li_hash->{unit_price});
 455
 456         if (not $incoming->purchase_order) {
 457             # PO should come from the EDI message, but if not...
 458
 459             # fetch the latest copy
 460             $incoming = $e->retrieve_acq_edi_message($incoming->id);
 461             $incoming->purchase_order($li->purchase_order);
 462
 463             unless($e->update_acq_edi_message($incoming)) {
 464                 $logger->error("EDI: unable to update edi_message " . $e->die_event);
 465                 next;
 466             }
 467         }
 468
 469         my $lids = $e->json_query({
 470             select => {acqlid => ['id']},
 471             from => 'acqlid',
 472             where => { lineitem => $li->id }
 473         });
 474
 475         my @lids = map { $_->{id} } @$lids;
 476         my $lid_count = scalar(@lids);
 477         my $lids_covered = 0;
 478         my $lids_touched = 0;
 479
 480         for my $qty (@{$li_hash->{quantities}}) {
 481
 482             my $qty_count = $qty->{quantity} or next;
 483             my $qty_code = $qty->{code};
 484
 485             if (!$qty_code) {
 486                 $logger->warn("EDI: Response for LI $li_id specifies quantity ".
 487                     "$qty_count with no 6063 code! Contact vendor to resolve.");
 488                 next;
 489             }
 490
 491             $logger->info("EDI: LI $li_id processing quantity count=$qty_count / code=$qty_code");
 492
 493             if ($qty_code eq '21') { # "ordered quantity"
 494                 $logger->info("EDI: LI $li_id -- vendor confirms $qty_count ordered");
 495                 $logger->warn("EDI: LI $li_id -- order count $qty_count ".
 496                     "does not match LID count $lid_count") unless $qty_count == $lid_count;
 497                 next;
 498             }
 499
 500             $lids_covered += $qty_count;
 501
 502             if ($qty_code eq '12') {
 503                 $logger->info("EDI: LI $li_id -- vendor dispatched $qty_count");
 504                 next;
 505
 506             } elsif ($qty_code eq '57') {
 507                 $logger->info("EDI: LI $li_id -- $qty_count in transit");
 508                 next;
 509             }
 510             # 84: urgent delivery
 511             # 118: quantity manifested
 512             # ...
 513
 514             # -------------------------------------------------------------------------
 515             # All of the remaining quantity types require that we apply a cancel_reason
 516             # DB populated w/ 6063 keys in 1200's
 517
 518             my $eg_reason = $e->retrieve_acq_cancel_reason(1200 + $qty_code);
 519
 520             if (!$eg_reason) {
 521                 $logger->warn("EDI: Unhandled quantity qty_code '$qty_code' ".
 522                     "for li $li_id.  $qty_count items unprocessed");
 523                 next;
 524             }
 525
 526             my $break = 0;
 527             foreach (1 .. $qty_count) {
 528
 529                 my $lid_id = shift @lids;
 530                 if (!$lid_id) {
 531                     $logger->warn("EDI: Used up all $lid_count LIDs. ".
 532                         "Ignoring extra status '" . $eg_reason->label . "'");
 533                     last;
 534                 }
 535
 536                 my $lid = $e->retrieve_acq_lineitem_detail($lid_id);
 537                 $lid->cancel_reason($eg_reason->id);
 538                 $e->update_acq_lineitem_detail($lid);
 539                 $lids_touched++;
 540
 541                 # if ALL the items have the same cancel_reason, the LI gets it too
 542                 $li->cancel_reason($eg_reason->id) if $qty_count == $lid_count;
 543
 544                 $li->edit_time('now');
 545                 unless ($e->update_acq_lineitem($li)) {
 546                     $logger->error("EDI: update_acq_lineitem failed " . $e->die_event);
 547                     $break = 1;
 548                     last;
 549                 }
 550             }
 551
 552             # non-recoverable transaction error
 553             # note in this case the commit below will be a silent no-op
 554             last if $break;
 555         }
 556
 557         # LI and LIDs updated, let's wrap this one up.
 558         $e->commit;
 559
 560         $logger->info("EDI LI $li_id -- $lids_covered LIDs mentioned; ".
 561             "$lids_touched LIDs had cancel_reason's applied");
 562     }
 563 }
 564
 565
 566 # create_acq_invoice_from_edi() does what it sounds like it does for INVOIC
 567 # messages.  For similar operation on ORDRSP messages, see the guts of
 568 # process_jedi().
 569 # Return boolean success indicator.
 570 sub create_acq_invoice_from_edi {
 571     my ($class, $invoice, $provider, $message) = @_;
 572     # $invoice is O::U::EDIReader hash
 573     # $provider is only a pkey
 574     # $message is Fieldmapper::acq::edi_message
 575
 576     my $e = new_editor();
 577
 578     my $log_prefix = "create_acq_invoice_from_edi(..., <acq.edi_message #" .
 579         $message->id . ">): ";
 580
 581     my $eg_inv = Fieldmapper::acq::invoice->new;
 582
 583     $eg_inv->provider($provider);
 584     $eg_inv->shipper($provider);    # XXX Do we really have a meaningful way to
 585                                     # distinguish provider and shipper?
 586     $eg_inv->recv_method("EDI");
 587
 588     my $buyer_san = $invoice->{buyer_san};
 589
 590     if (not $buyer_san) {
 591         $logger->error($log_prefix . "could not find buyer SAN in INVOIC");
 592         return 0;
 593     }
 594
 595     # some vendors encode the SAN as "$SAN $vendcode"
 596     $buyer_san =~ s/\s.*//g;
 597
 598     # Find the matching org unit based on SAN via 'aoa' table.
 599     my $addrs =
 600         $e->search_actor_org_address({valid => "t", san => $buyer_san});
 601
 602     if (not $addrs or not @$addrs) {
 603         $logger->error(
 604             $log_prefix . "couldn't find OU unit matching buyer SAN in INVOIC:".
 605             $e->event
 606         );
 607         return 0;
 608     }
 609
 610     # XXX Should we verify that this matches PO ordering agency later?
 611     $eg_inv->receiver($addrs->[0]->org_unit);
 612
 613     $eg_inv->inv_ident($invoice->{invoice_ident});
 614
 615     if (!$eg_inv->inv_ident) {
 616         $logger->error(
 617             $log_prefix . "no invoice ID # in INVOIC message; " . shift
 618         );
 619         return 0;
 620     }
 621
 622     my @eg_inv_entries;
 623
 624     $message->purchase_order($invoice->{purchase_order});
 625
 626     for my $lineitem (@{$invoice->{lineitems}}) {
 627         my $li_id = $lineitem->{id};
 628
 629         if (!$li_id) {
 630             $logger->warn($log_prefix . "no lineitem ID");
 631             next;
 632         }
 633
 634         my $li = $e->retrieve_acq_lineitem($li_id);
 635
 636         if (!$li) {
 637             $logger->warn($log_prefix .
 638                 "no LI found with ID: $li_id : " . $e->event);
 639             return 0;
 640         }
 641
 642         my ($quant) = grep {$_->{code} eq '47'} @{$lineitem->{quantities}};
 643         my $quantity = ($quant) ? $quant->{quantity} : 0;
 644
 645         if (!$quantity) {
 646             $logger->warn($log_prefix .
 647                 "no invoice quantity specified for LI $li_id");
 648             next;
 649         }
 650
 651         # NOTE: if needed, we also have $lineitem->{net_unit_price}
 652         # and $lineitem->{gross_unit_price}
 653         my $lineitem_price = $lineitem->{amount_billed};
 654
 655         # if the top-level PO value is unset, get it from the first LI
 656         $message->purchase_order($li->purchase_order)
 657             unless $message->purchase_order;
 658
 659         my $eg_inv_entry = Fieldmapper::acq::invoice_entry->new;
 660         $eg_inv_entry->inv_item_count($quantity);
 661
 662         # XXX Validate by making sure the LI is on-order and belongs to
 663         # the right provider and ordering agency and all that.
 664         $eg_inv_entry->lineitem($li_id);
 665
 666         # XXX Do we actually need to link to PO directly here?
 667         $eg_inv_entry->purchase_order($li->purchase_order);
 668
 669         # This is the total price for all units billed, not per-unit.
 670         $eg_inv_entry->cost_billed($lineitem_price);
 671
 672         push @eg_inv_entries, $eg_inv_entry;
 673     }
 674
 675     my @eg_inv_items;
 676
 677     my %charge_type_map = (
 678         'TX' => ['TAX', 'Tax from electronic invoice'],
 679         'CA' => ['PRO', 'Cataloging services'],
 680         'DL' => ['SHP', 'Delivery']
 681     );
 682
 683     for my $charge (@{$invoice->{misc_charges}}) {
 684         my $eg_inv_item = Fieldmapper::acq::invoice_item->new;
 685
 686         my $amount = $charge->{charge_amount};
 687
 688         if (!$amount) {
 689             $logger->warn($log_prefix . "charge with no amount");
 690             next;
 691         }
 692
 693         my $map = $charge_type_map{$charge->{charge_type}};
 694
 695         if (!$map) {
 696             $map = [
 697                 'PRO',
 698                 'Unknown charge type ' .  $charge->{charge_type}
 699             ];
 700         }
 701
 702         $eg_inv_item->inv_item_type($$map[0]);
 703         $eg_inv_item->note($$map[1]);
 704         $eg_inv_item->cost_billed($amount);
 705
 706         push @eg_inv_items, $eg_inv_item;
 707     }
 708
 709     $logger->info($log_prefix .
 710         sprintf("creating invoice with %d entries and %d items.",
 711             scalar(@eg_inv_entries), scalar(@eg_inv_items)));
 712
 713     $e->xact_begin;
 714
 715     # save changes to acq.edi_message row
 716     if (not $e->update_acq_edi_message($message)) {
 717         $logger->error(
 718             $log_prefix . "couldn't update edi_message " . $message->id
 719         );
 720         return 0;
 721     }
 722
 723     # create EG invoice
 724     if (not $e->create_acq_invoice($eg_inv)) {
 725         $logger->error($log_prefix . "couldn't create invoice: " . $e->event);
 726         return 0;
 727     }
 728
 729     # Now we have a pkey for our EG invoice, so set the invoice field on all
 730     # our entries according and create those too.
 731     my $eg_inv_id = $e->data->id;
 732     foreach (@eg_inv_entries) {
 733         $_->invoice($eg_inv_id);
 734         if (not $e->create_acq_invoice_entry($_)) {
 735             $logger->error(
 736                 $log_prefix . "couldn't create entry against lineitem " .
 737                 $_->lineitem . ": " . $e->event
 738             );
 739             return 0;
 740         }
 741     }
 742
 743     # Create any invoice items (taxes)
 744     foreach (@eg_inv_items) {
 745         $_->invoice($eg_inv_id);
 746         if (not $e->create_acq_invoice_item($_)) {
 747             $logger->error(
 748                 $log_prefix . "couldn't create inv item: " . $e->event
 749             );
 750             return 0;
 751         }
 752     }
 753
 754     $e->xact_commit;
 755     return 1;
 756 }
 757
 758 1;
 759