Custom/local EDI reader module for ORDRSP and INVOIC (etc)
[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::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