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