1 package OpenILS::Application::Acq::EDI;
2 use base qw/OpenILS::Application/;
4 use strict; use warnings;
8 use OpenSRF::AppSession;
9 use OpenSRF::EX qw/:try/;
10 use OpenSRF::Utils::Logger qw(:logger);
11 use OpenSRF::Utils::JSON;
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;
19 use OpenILS::Utils::LooseEDI;
26 my($class, %args) = @_;
27 my $self = bless(\%args, $class);
32 # our $reasons = {}; # cache for acq.cancel_reason rows ?
37 return $translator ||= OpenILS::Application::Acq::EDI::Translator->new(@_);
41 host => 'remote_host',
42 username => 'remote_user',
43 password => 'remote_password',
44 account => 'remote_account',
45 # in_dir => 'remote_path', # field_map overrides path with in_dir
46 path => 'remote_path',
50 ## Just for debugging stuff:
52 my ($self, $conn) = @_;
53 my $e = new_editor(xact=>1);
54 my $incoming = Fieldmapper::acq::edi_message->new;
55 $incoming->edi("This is content");
56 $incoming->account(1);
57 $incoming->remote_file('in/some_file.edi');
58 $e->create_acq_edi_message($incoming);;
61 # __PACKAGE__->register_method( method => 'add_a_msg', api_name => 'open-ils.acq.edi.add_a_msg'); # debugging
63 __PACKAGE__->register_method(
65 api_name => 'open-ils.acq.edi.retrieve',
68 desc => 'Fetch incoming message(s) from EDI accounts. ' .
69 'Optional arguments to restrict to one vendor and/or a max number of messages. ' .
70 'Note that messages are not parsed or processed here, just fetched and translated.',
72 {desc => 'Authentication token', type => 'string'},
73 {desc => 'Vendor ID (undef for "all")', type => 'number'},
74 {desc => 'Date Inactive Since', type => 'string'},
75 {desc => 'Max Messages Retrieved', type => 'number'}
78 desc => 'List of new message IDs (empty if none)',
85 my ($self, $set, $max, $e, $test) = @_; # $e is a working editor
88 $set ||= __PACKAGE__->retrieve_vendors($e);
92 foreach my $account (@$set) {
95 $logger->info("EDI check for vendor " . ++$vcount . " of " . scalar(@$set) . ": " . $account->host);
96 unless ($server = __PACKAGE__->remote_account($account)) { # assignment, not comparison
97 $logger->err(sprintf "Failed remote account mapping for %s (%s)", $account->host, $account->id);
100 # my $rf_starter = './'; # default to current dir
101 if ($account->in_dir) {
102 if ($account->in_dir =~ /\*+.*\//) {
103 $logger->err("EDI in_dir has a slash after an asterisk in value: '" . $account->in_dir . "'. Skipping account with indeterminate target dir!");
106 # $rf_starter = $account->in_dir;
107 # $rf_starter =~ s/((\/)?[^\/]*)\*+[^\/]*$//; # kill up to the first (possible) slash before the asterisk: keep the preceeding static dir
108 # $rf_starter .= '/' if $rf_starter or $2; # recap the dir, or replace leading "/" if there was one (but don't add if empty)
110 my @files = ($server->ls({remote_file => ($account->in_dir || './')}));
111 my @ok_files = grep {$_ !~ /\/\.?\.$/ and $_ ne '0'} @files;
112 $logger->info(sprintf "%s of %s files at %s/%s", scalar(@ok_files), scalar(@files), $account->host, $account->in_dir);
113 # $server->remote_path(undef);
114 foreach my $remote_file (@ok_files) {
115 # my $remote_file = $rf_starter . $_;
116 my $description = sprintf "%s/%s", $account->host, $remote_file;
118 # deduplicate vs. acct/filenames already in DB
119 my $hits = $e->search_acq_edi_message([
121 account => $account->id,
122 remote_file => $remote_file,
123 status => {'in' => [qw/ processed /]}, # if it never got processed, go ahead and get the new one (try again)
124 # create_time => 'NOW() - 60 DAYS', # if we wanted to allow filenames to be reused after a certain time
125 # ideally we would also use the date from FTP, but that info isn't available via RemoteAccount
127 # { flesh => 1, flesh_fields => {...}, }
129 if (scalar(@$hits)) {
130 $logger->debug("EDI: $remote_file already retrieved. Skipping");
131 warn "EDI: $remote_file already retrieved. Skipping";
136 $max and $count > $max and last;
137 $logger->info(sprintf "%s of %s targets: %s", $count, scalar(@ok_files), $description);
138 print sprintf "%s of %s targets: %s\n", $count, scalar(@ok_files), $description;
140 push @return, "test_$count";
144 my $io = IO::Scalar->new(\$content);
145 unless ( $server->get({remote_file => $remote_file, local_file => $io}) ) {
146 $logger->error("(S)FTP get($description) failed");
149 my $incoming = __PACKAGE__->process_retrieval($content, $remote_file, $server, $account->id, $e);
150 # $server->delete(remote_file => $_); # delete remote copies of saved message
151 push @return, $incoming->id;
157 # my $in = OpenILS::Application::Acq::EDI->process_retrieval($file_content, $remote_filename, $server, $account_id, $editor);
159 sub process_retrieval {
160 my $incoming = Fieldmapper::acq::edi_message->new;
161 my ($class, $content, $remote, $server, $account_or_id, $e) = @_;
165 my $account = __PACKAGE__->record_activity( $account_or_id, $e );
167 my $z; # must predeclare
168 $z = ( $content =~ s/('UNH\+\d+\+ORDRSP:)0(:96A:UN')/$1D$2/g )
169 and $logger->warn("Patching bogus spec reference ORDRSP:0:96A:UN => ORDRSP:D:96A:UN ($z times)"); # Hack/fix some faulty "0" in (B&T) data
171 $incoming->remote_file($remote);
172 $incoming->account($account->id);
173 $incoming->edi($content);
174 $incoming->message_type(($content =~ /'UNH\+\d+\+(\S{6}):/) ? $1 : 'ORDRSP'); # cheap sniffing, ORDRSP fallback
175 __PACKAGE__->attempt_translation($incoming);
177 $e->create_acq_edi_message($incoming);
179 # refresh: send process_jedi the updated row
182 # LFW: I really don't understand in what sense you could call this
183 # message 'outgoing', except from the vendor's point of view?
184 my $outgoing = $e->retrieve_acq_edi_message($incoming->id); # refresh again!
186 my $res = __PACKAGE__->process_jedi($outgoing, $server, $account, $e);
188 $outgoing = $e->retrieve_acq_edi_message($incoming->id); # refresh again!
190 $outgoing->status($res ? 'processed' : 'proc_error');
193 $e->update_acq_edi_message($outgoing);
200 # $account is a Fieldmapper object for acq.edi_account row
201 # $messageset is an arrayref with acq.edi_message.id values
202 # $e is optional editor object
204 my ($class, $account, $message_ids, $e) = @_; # $e is a working editor
206 ($account and scalar @$message_ids) or return;
210 my @messageset = map {$e->retrieve_acq_edi_message($_)} @$message_ids;
212 my $m_count = scalar(@messageset);
213 (scalar(@$message_ids) == $m_count) or
214 $logger->warn(scalar(@$message_ids) - $m_count . " bad IDs passed to send_core (ignored)");
216 my $log_str = sprintf "EDI send to edi_account %s (%s)", $account->id, $account->host;
217 $logger->info("$log_str: $m_count message(s)");
222 unless ($server = __PACKAGE__->remote_account($account, 1)) { # assignment, not comparison
223 $logger->error("Failed remote account connection for $log_str");
226 foreach (@messageset) {
227 $_ or next; # we already warned about bum ids
230 $error = "Server error: Failed remote account connection for $log_str"; # already told $logger, this is to update object below
231 } elsif (! $_->edi) {
232 $logger->error("Message (id " . $_->id. ") for $log_str has no EDI content");
233 $error = "EDI empty!";
234 } elsif ($res = $server->put({remote_path => $account->path, content => $_->edi, single_ext => 1})) {
235 # This is the successful case!
236 $_->remote_file($res);
237 $_->status('complete');
238 $_->process_time('NOW'); # For outbound files, sending is the end of processing on the EG side.
239 $logger->info("Sent message (id " . $_->id. ") via $log_str");
241 $logger->error("(S)FTP put to $log_str FAILED: " . ($server->error || 'UNKOWNN'));
242 $error = "put FAILED: " . ($server->error || 'UNKOWNN');
246 $_->error_time('NOW');
248 $logger->info("Calling update_acq_edi_message");
250 unless ($e->update_acq_edi_message($_)) {
251 $logger->error("EDI send_core update_acq_edi_message failed for message object: " . Dumper($_));
252 OpenILS::Application::Acq::EDI::Translator->debug_file(Dumper($_ ), '/tmp/update_acq_edi_message.FAIL');
253 OpenILS::Application::Acq::EDI::Translator->debug_file(Dumper($_->to_bare_hash), '/tmp/update_acq_edi_message.FAIL.to_bare_hash');
255 # There's always an update, even if we failed.
257 __PACKAGE__->record_activity($account, $e); # There's always an update, even if we failed.
262 # attempt_translation does not touch the DB, just the object.
263 sub attempt_translation {
264 my ($class, $edi_message, $to_edi) = @_;
265 my $tran = translator();
266 my $ret = $to_edi ? $tran->json2edi($edi_message->jedi) : $tran->edi2json($edi_message->edi);
267 # $logger->error("json: " . Dumper($json)); # debugging
268 if (not $ret or (! ref($ret)) or $ret->is_fault) { # RPC::XML::fault on failure
269 $edi_message->status('trans_error');
270 $edi_message->error_time('NOW');
271 my $pre = "EDI Translator " . ($to_edi ? 'json2edi' : 'edi2json') . " failed";
272 my $message = ref($ret) ?
273 ("$pre, Error " . $ret->code . ": " . __PACKAGE__->nice_string($ret->string)) :
274 ("$pre: " . __PACKAGE__->nice_string($ret) ) ;
275 $edi_message->error($message);
276 $logger->error( $message);
279 $edi_message->status('translated');
280 $edi_message->translate_time('NOW');
282 $edi_message->edi($ret->value); # translator returns an object
284 $edi_message->jedi($ret->value); # translator returns an object
289 sub retrieve_vendors {
290 my ($self, $e, $vendor_id, $last_activity) = @_; # $e is a working editor
294 my $criteria = {'+acqpro' => {active => 't'}};
295 $criteria->{'+acqpro'}->{id} = $vendor_id if $vendor_id;
296 return $e->search_acq_edi_account([
301 acqedi => ['provider']
305 # {"id":{"!=":null},"+acqpro":{"active":"t"}}, {"join":"acqpro", "flesh_fields":{"acqedi":["provider"]},"flesh":1}
308 # This is the SRF-exposed call, so it does checkauth
311 my ($self, $conn, $auth, $vendor_id, $last_activity, $max) = @_;
313 my $e = new_editor(authtoken=>$auth);
314 unless ($e and $e->checkauth()) {
315 $logger->warn("checkauth failed for authtoken '$auth'");
318 # return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency); # add permission here ?
320 my $set = __PACKAGE__->retrieve_vendors($e, $vendor_id, $last_activity) or return $e->die_event;
321 return __PACKAGE__->retrieve_core($e, $set, $max);
325 # field_map takes the hashref of vendor data with fields from acq.edi_account and
326 # maps them to the argument style needed for RemoteAccount. It also extrapolates
327 # data from the remote_host string for type and port, when available.
331 my $vendor = shift or return;
332 my $no_override = @_ ? shift : 0;
334 $verbose and $logger->warn("vendor: " . Dumper($vendor));
335 foreach (keys %map) {
336 $args{$map{$_}} = $vendor->$_ if defined $vendor->$_;
338 unless ($no_override) {
339 $args{remote_path} = $vendor->in_dir; # override "path" with "in_dir"
341 my $host = $args{remote_host} || '';
342 ($host =~ s/^(S?FTP)://i and $args{type} = uc($1)) or
343 ($host =~ s/^(SSH|SCP)://i and $args{type} = 'SCP' ) ;
344 $host =~ s/:(\d+)$// and $args{port} = $1;
345 ($args{remote_host} = $host) =~ s#/+##;
346 $verbose and $logger->warn("field_map: " . Dumper(\%args));
351 # The point of remote_account is to get the RemoteAccount object with args from the DB
354 my ($self, $vendor, $outbound, $e) = @_;
356 unless (ref($vendor)) { # It's not a hashref/object.
357 $vendor or return; # If in fact it's nothing: abort!
358 # else it's a vendor_id string, so get the full vendor data
360 my $set_of_one = $self->retrieve_vendors($e, $vendor) or return;
361 $vendor = shift @$set_of_one;
364 return OpenILS::Utils::RemoteAccount->new(
365 $self->field_map($vendor, $outbound)
369 # takes account ID or account Fieldmapper object
371 sub record_activity {
372 my ($class, $account_or_id, $e) = @_;
373 $account_or_id or return;
375 my $account = ref($account_or_id) ? $account_or_id : $e->retrieve_acq_edi_account($account_or_id);
376 $logger->info("EDI record_activity calling update_acq_edi_account");
377 $account->last_activity('NOW') or return;
379 $e->update_acq_edi_account($account) or $logger->warn("EDI: in record_activity, update_acq_edi_account FAILED");
386 my $string = shift or return '';
388 my $head = @_ ? shift : 100;
389 my $tail = @_ ? shift : 25;
390 (length($string) < $head + $tail) and return $string;
391 my $h = substr($string,0,$head);
392 my $t = substr($string, -1*$tail);
396 # return substr($string,0,$head) . "... " . substr($string, -1*$tail);
400 my ($class, $jedi) = @_;
402 my $msg = OpenSRF::Utils::JSON->JSON2perl( $jedi );
403 open (FOO, ">>/tmp/JSON2perl_dump.txt");
404 print FOO Dumper($msg), "\n\n";
406 $logger->warn("Dumped JSON2perl to /tmp/JSON2perl_dump.txt");
410 our @datecodes = (35, 359, 17, 191, 69, 76, 75, 79, 85, 74, 84, 223);
411 our @noop_6063 = (21);
413 # ->process_jedi($message, $server, $remote, $e)
414 # $message is an edi_message object
416 # This method has lots of logic to process ORDRSP messages (and theoretically
417 # OSTRPT messages) and to make changes based on those to EG acq objects.
418 # If it gets an INVOIC message, it hands that off to
419 # create_acq_invoice_from_edi() following a new model (this code all wants
420 # cleaned-up/refactored).
422 # This method currently returns an array of message objects, but no callers use
423 # that except in a boolean evaluation to test for success. So don't count on
424 # that array being there or containing anything specific in the future: it
427 my ($class, $message, $server, $remote, $e) = @_;
429 $server ||= {}; # context
430 $remote ||= {}; # context
433 unless (ref($message) and $jedi = $message->jedi) { # assignment, not comparison
434 $logger->warn("EDI process_jedi missing required argument (edi_message object with jedi)!");
437 my $perl = __PACKAGE__->jedi2perl($jedi);
439 if (ref($message) and not $perl) {
440 $error = ($message->error || '') . " JSON2perl (jedi2perl) FAILED to convert jedi";
442 elsif (! $perl->{body}) {
443 $error = "EDI interchange body not found!";
445 elsif (! $perl->{body}->[0]) {
446 $error = "EDI interchange body not a populated arrayref!";
449 $logger->warn($error);
450 $message->error($error);
451 $message->error_time('NOW');
453 $e->update_acq_edi_message($message) or $logger->warn("EDI update_acq_edi_message failed! $!");
458 # Crazy data structure. Most of the arrays will be 1 element... we think.
460 # {'body' => [{'ORDERS' => [['UNH',{'0062' => '4635','S009' => {'0057' => 'EAN008','0051' => 'UN','0052' => 'D','0065' => 'ORDERS', ...
462 # So you might access it like:
463 # $obj->{body}->[0]->{ORDERS}->[0]->[0] eq 'UNH'
465 $logger->info("EDI interchange body has " . scalar(@{$perl->{body}}) . " message(s)");
466 my @ok_msg_codes = qw/ORDRSP OSTRPT INVOIC/;
469 foreach my $part (@{$perl->{body}}) {
471 unless (ref $part and scalar keys %$part) {
472 $logger->warn("EDI interchange message $i lacks structure. Skipping it.");
475 foreach my $key (keys %$part) {
476 if (! grep {$_ eq $key} @ok_msg_codes) { # We only do one type for now. TODO: other types here
477 $logger->warn("EDI interchange $i contains unhandled '$key' message. Ignoring it.");
480 if ($key eq 'INVOIC') {
481 # XXX TODO Maybe subclass O::U::LooseEDI::Message as
482 # something like OpenILS::Acq::{VendorInvoice,OrderReponse},
483 # each one knowing how to read itself and update EG acq
484 # objects (not under OpenILS::Application perhaps).
485 my $invoice_message =
486 new OpenILS::Utils::LooseEDI::Message($part->{$key});
487 push @messages, $invoice_message if
488 $class->create_acq_invoice_from_edi(
489 $e, $invoice_message, $remote->provider, $message
494 my $msg = __PACKAGE__->message_object($part->{$key}) or next;
495 push @messages, $msg;
497 my $bgm = $msg->xpath('BGM') or $logger->warn("EDI No BGM segment found?!");
498 my $tag4343 = $msg->xpath('BGM/4343');
499 my $tag1225 = $msg->xpath('BGM/1225');
501 $logger->info(sprintf "EDI $key BGM/4343 Response Type: %s - %s", $tag4343->value, $tag4343->label)
503 $logger->warn("EDI $key BGM/4343 Response Type Code unrecognized"); # next; #?
506 $logger->info(sprintf "EDI $key BGM/1225 Message Function: %s - %s", $tag1225->value, $tag1225->label);
508 $logger->warn("EDI $key BGM/1225 Message Function Code unrecognized"); # next; #?
511 # TODO: currency check, just to be paranoid
512 # *should* be unnecessary (vendor should reply in currency we send in ORDERS)
513 # That begs a policy question: how to handle mismatch? convert (bad accuracy), reject, or ignore? I say ignore.
515 # ALL those codes below are basically some form of (lastest) delivery date/time
516 # see, e.g.: http://www.stylusstudio.com/edifact/D04B/2005.htm
517 # The order is the order of definitiveness (first match wins)
518 # Note: if/when we do serials via EDI, dates (and ranges/periods) will need massive special handling
522 foreach my $date ($msg->xpath('delivery_schedule')) {
523 my $val_2005 = $date->xpath_value('DTM/2005') or next;
524 (grep {$val_2005 eq $_} @datecodes) or next; # no match means some other kind of date we don't care about
528 DATECODE: foreach my $dcode (@datecodes) { # now cycle back through hits in order of dcode definitiveness
529 foreach my $date (@dates) {
530 $date->xpath_value('DTM/2005') == $dcode or next;
531 $ddate = $date->xpath_value('DTM/2380') and last DATECODE;
532 # TODO: conversion based on format specified in DTM/2379 (best encapsulated in Business::EDI)
536 foreach my $detail ($msg->part('line_detail')) {
537 my $eg_line = __PACKAGE__->eg_li($detail, $remote, $server->{remote_host}, $e) or next;
538 my $li_date = $detail->xpath_value('DTM/2380') || $ddate;
539 my $price = $detail->xpath_value('line_price/PRI/5118') || '';
540 $eg_line->expected_recv_time($li_date) if $li_date;
541 $eg_line->estimated_unit_price($price) if $price;
542 if (not $message->purchase_order) { # first good lineitem sets the message PO link
543 $message->purchase_order($eg_line->purchase_order); # EG $message object NOT Business::EDI $msg object
545 $e->update_acq_edi_message($message) or $logger->warn("EDI update_acq_edi_message (for PO number) failed! $!");
548 # $e->search_acq_edi_account([]);
550 my $eg_lids = $e->search_acq_lineitem_detail({lineitem => $eg_line->id}); # should be the same as $eg_line->lineitem_details
551 my $lidcount = scalar(@$eg_lids);
552 $lidcount == $eg_line->item_count or $logger->warn(
553 sprintf "EDI: LI %s itemcount (%d) mismatch, %d LIDs found", $eg_line->id, $eg_line->item_count, $lidcount
555 foreach my $qty ($detail->part('all_QTY')) {
556 my $ubound = $qty->xpath_value('6060') or next; # nothing to do if qty is 0
557 my $val_6063 = $qty->xpath_value('6063');
558 $ubound > 0 or next; # don't be crazy!
560 $logger->warn("EDI: Response for LI " . $eg_line->id . " specifies quantity $ubound with no 6063 code! Contact vendor to resolve.");
564 my $eg_reason = $e->retrieve_acq_cancel_reason(1200 + $val_6063); # DB populated w/ 6063 keys in 1200's
566 $logger->warn("EDI: Unhandled quantity code '$val_6063' (LI " . $eg_line->id . ") $ubound items unprocessed");
568 } elsif (grep {$val_6063 == $_} @noop_6063) { # an FYI like "ordered quantity"
570 or $logger->warn("EDI: LI " . $eg_line->id . " -- Vendor says we ordered $ubound, but we have $lidcount LIDs!)");
573 # elsif ($val_6063 == 83) { # backorder
574 #} elsif ($val_6063 == 85) { # cancel
575 #} elsif ($val_6063 == 12 or $val_6063 == 57 or $val_6063 == 84 or $val_6063 == 118) {
576 # despatched, in transit, urgent delivery, or quantity manifested
578 if ($touches >= $lidcount) {
579 $logger->warn("EDI: LI " . $eg_line->id . ", We already updated $touches of $lidcount LIDS, " .
580 "but message wants QTY $ubound more set to " . $eg_reason->label . ". Ignoring!");
584 foreach (1 .. $ubound) {
585 my $eg_lid = shift @$eg_lids or $logger->warn("EDI: Used up all $lidcount LIDs! Ignoring extra status " . $eg_reason->label);
587 $logger->debug(sprintf "Updating LID %s to %s", $eg_lid->id, $eg_reason->label);
588 $eg_lid->cancel_reason($eg_reason->id);
589 $e->update_acq_lineitem_detail($eg_lid);
593 if ($ubound == $eg_line->item_count) {
594 $eg_line->cancel_reason($eg_reason->id); # if ALL the items have the same cancel_reason, the PO gets it too
597 $eg_line->edit_time('NOW'); # TODO: have this field automatically updated via ON UPDATE trigger.
599 $e->update_acq_lineitem($eg_line) or $logger->warn("EDI: update_acq_lineitem FAILED");
601 # print STDERR "Lineitem update: ", Dumper($eg_line);
609 # create_acq_invoice_from_edi() does what it sounds like it does for INVOIC
610 # messages. For similar operation on ORDRSP messages, see the guts of
612 # Return boolean success indicator.
613 sub create_acq_invoice_from_edi {
614 my ($class, $e, $invoice, $provider, $message) = @_;
615 # $invoice is O::U::LooseEDI::Message, representing the EDI invoice message.
616 # $provider is only a pkey
617 # $message is Fieldmapper::acq::edi_message
619 my $log_prefix = "create_acq_invoice_from_edi(..., <acq.edi_message #" .
620 $message->id . ">): ";
622 my $eg_inv = Fieldmapper::acq::invoice->new;
624 $eg_inv->provider($provider);
625 $eg_inv->shipper($provider); # XXX Do we really have a meaningful way to
626 # distinguish provider and shipper?
627 $eg_inv->recv_method("EDI");
629 # Find the buyer's identifier in the invoice.
631 foreach (@{$invoice->{SG2}}) {
632 my $nad = $_->{NAD}[0];
633 if ($nad->{3035} eq 'BY' and $nad->{C082}{3055} eq '91') {
634 $buyer_san = $nad->{C082}{3039};
638 if (not $buyer_san) {
639 $logger->error($log_prefix . "could not find buyer SAN in INVOIC");
643 # Find the matching org unit based on SAN via 'aoa' table.
645 $e->search_actor_org_address({valid => "t", san => $buyer_san});
647 if (not $addrs or not @$addrs) {
649 $log_prefix . "couldn't find OU unit matching buyer SAN in INVOIC:".
655 # XXX Should we verify that this matches PO ordering agency later?
656 $eg_inv->receiver($addrs->[0]->org_unit);
659 $eg_inv->inv_ident($invoice->{BGM}[0]{1004});
662 $log_prefix . "no invoice ID # in INVOIC message; " . shift
665 return 0 unless $eg_inv->inv_ident;
669 # The invoice message will have once instance of segment group 25
671 foreach my $sg25 (@{ $invoice->{SG25} }) {
673 my $c186 = $sg25->{QTY}[0]{C186};
674 my $quantity = $c186->{6060};
675 # $c186->{6411} will probably say 'PCE', but need we check it?
677 # identifiers (typically ISBN for us, and we may not need these)
678 my @identifiers = ();
681 my $c212 = $sg25->{LIN}[0]{C212};
682 push @identifiers, [$c212->{7143}, $c212->{7140}] if
683 $c212 and ref $c212 eq 'HASH';
690 foreach my $pia (@{ $sg25->{PIA} }) {
691 foreach my $h (@{$pia->{C212}}) {
692 push @identifiers, [$h->{7143}, $h->{7140}];
699 # @identifiers now contains lists of, say,
700 # ['IB', '0786222735'], # ISBN 10
701 # ['EN','9780786222735'] # ISBN 13
703 # Segment Group 26-47 are all descendants of SG25.
705 # Segment Group 26 concerns *lineitem* price (i.e, total for all copies
708 my $lineitem_price = $sg25->{SG26}[0]{MOA}[0]{C516}{5004};
710 # Segment Group 28 concerns *unit* (lineitem detail) price. We may
711 # not actually use this. TBD.
713 foreach my $sg28 (@{$sg25->{SG28}}) {
714 my $c509 = $sg28->{PRI}[0]{C509};
715 my ($price_qualifier, $price_qualifier_type);
716 ($per_unit_price, $price_qualifier, $price_qualifier_type) = (
717 $c509->{5118}, $c509->{5125}, $c509->{5387}
720 # price_qualifier=AAA seems to be the price to use. Otherwise,
721 # take what we can get.
722 last if $price_qualifier eq 'AAA';
725 # Segment Group 29 will have references to LI and PO numbers
726 my $acq_identifiers = {};
727 foreach my $sg29 (@{$sg25->{SG29}}) {
728 foreach my $rff (@{$sg29->{RFF}}) {
729 my $c506 = $rff->{C506};
730 if ($c506->{1153} eq 'ON') {
731 $acq_identifiers->{po} = $c506->{1154};
732 } elsif ($c506->{1153} eq 'LI') {
733 my ($po, $li) = split m./., $c506->{1154};
735 if ($acq_identifiers->{po}) {
738 "RFFs within lineitem disagree on PO # ?"
739 ) unless $acq_identifiers->{po} eq $po;
741 $acq_identifiers->{li} = $li;
742 $acq_identifiers->{po} = $po;
746 "RFF 1154 doesn't match expectations (.+/.+) " .
754 if ($acq_identifiers->{po}) {
755 # First PO number seen in INVOIC sets the purchase_order field for
756 # the entry in acq.edi_message (which model may need a rethink).
758 $message->purchase_order($acq_identifiers->{po}) unless
759 $message->purchase_order;
763 "SG29 missing or refers to no purchase order that we can tell"
766 if (not $acq_identifiers->{li}) {
769 "SG29 missing or refers to no lineitem that we can tell"
773 my $eg_inv_entry = Fieldmapper::acq::invoice_entry->new;
774 $eg_inv_entry->inv_item_count($quantity);
776 # XXX Validate by making sure the LI is on-order and belongs to
777 # the right provider and ordering agency and all that.
778 $eg_inv_entry->lineitem($acq_identifiers->{li});
780 # XXX Do we actually need to link to PO directly here?
781 $eg_inv_entry->purchase_order($acq_identifiers->{po});
783 # This is the total price for all units billed, not per-unit.
784 $eg_inv_entry->cost_billed($lineitem_price);
786 push @eg_inv_entries, $eg_inv_entry;
791 # Find any taxes applied to the whole invoice.
793 if ($invoice->{SG50}) {
794 foreach my $sg50 (@{ $invoice->{SG50} }) {
795 if ($sg50->{TAX} and $sg50->{MOA}) {
796 my $tax_amount = $sg50->{MOA}[0]{C516}{5004};
798 my $eg_inv_item = Fieldmapper::acq::invoice_item->new;
799 $eg_inv_item->inv_item_type('TAX');
800 $eg_inv_item->cost_billed($tax_amount);
801 # XXX i18n somehow? or maybe omit the note.
802 $eg_inv_item->note('Tax from electronic invoice');
804 push @eg_inv_items, $eg_inv_item;
814 # save changes to acq.edi_message row
815 if (not $e->update_acq_edi_message($message)) {
817 $log_prefix . "couldn't update edi_message " . $message->id
823 if (not $e->create_acq_invoice($eg_inv)) {
824 $logger->error($log_prefix . "couldn't create invoice: " . $e->event);
828 # Now we have a pkey for our EG invoice, so set the invoice field on all
829 # our entries according and create those too.
830 my $eg_inv_id = $e->data->id;
831 foreach (@eg_inv_entries) {
832 $_->invoice($eg_inv_id);
833 if (not $e->create_acq_invoice_entry($_)) {
835 $log_prefix . "couldn't create entry against lineitem " .
836 $_->lineitem . ": " . $e->event
842 # Create any invoice items (taxes)
843 foreach (@eg_inv_items) {
844 $_->invoice($eg_inv_id);
845 if (not $e->create_acq_invoice_item($_)) {
847 $log_prefix . "couldn't create inv item: " . $e->event
857 # returns message object if processing should continue
858 # returns false/undef value if processing should abort
862 my $body = shift or return;
863 my $key = shift if @_;
864 my $keystring = $key || 'UNSPECIFIED';
866 my $msg = Business::EDI::Message->new($body);
868 $logger->error("EDI interchange message: $keystring body failed Business::EDI constructor. Skipping it.");
871 $key = $msg->code if ! $key; # Now we set the key for reference if it wasn't specified
872 my $val_0065 = $msg->xpath_value('UNH/S009/0065') || '';
873 unless ($val_0065 eq $key) {
874 $logger->error("EDI $key UNH/S009/0065 ('$val_0065') conflicts w/ message type $key. Aborting");
877 my $val_0051 = $msg->xpath_value('UNH/S009/0051') || '';
878 unless ($val_0051 eq 'UN') {
879 $logger->warn("EDI $key UNH/S009/0051 designates '$val_0051', not 'UN' as controlling agency. Attempting to process anyway");
881 my $val_0054 = $msg->xpath_value('UNH/S009/0054') || '';
883 $logger->info("EDI $key UNH/S009/0054 uses Spec revision version '$val_0054'");
884 # Possible Spec Version limitation
885 # my $yy = $tag_0054 ? substr($val_0054,0,2) : '';
886 # unless ($yy eq '00' or $yy > 94 ...) {
887 # $logger->warn("EDI $key UNH/S009/0051 Spec revision version '$val_0054' not supported");
890 $logger->warn("EDI $key UNH/S009/0054 does not reference a known Spec revision version");
895 =head2 ->eg_li($lineitem_object, [$remote, $server_log_string, $editor])
897 my $line_item = OpenILS::Application::Acq::EDI->eg_li($edi_line, $remote, "test_server_01", $e);
899 $remote is a acq.edi_account Fieldmapper object.
900 $server_log_string is an arbitrary string use to identify the remote host in potential log messages.
903 acq.lineitem.estimated_unit_price,
904 acq.lineitem.state (dependent on mapping codes),
905 acq.lineitem.expected_recv_time,
906 acq.lineitem.edit_time (consequently)
911 my ($class, $line, $server, $server_log_string, $e) = @_;
916 # my $rff = $line->part('line_reference/RFF') or $logger->warn("EDI ORDRSP line_detail/RFF missing!");
917 my $val_1153 = $line->xpath_value('line_reference/RFF/1153') || '';
918 my $val_1154 = $line->xpath_value('line_reference/RFF/1154') || '';
919 my $val_1082 = $line->xpath_value('LIN/1082') || '';
923 $val_1154 =~ s#^(.*)\/##; # Many sources send the ID as 'order_ID/LI_ID'
924 $1 and push @po_nums, $1;
925 $val_1082 =~ s#^(.*)\/##; # Many sources send the ID as 'order_ID/LI_ID'
926 $1 and push @po_nums, $1;
928 # TODO: possible check of po_nums
929 # now do a lot of checking
931 if ($val_1153 eq 'LI') {
932 $id = $val_1154 or $logger->warn("EDI ORDRSP RFF/1154 reference to LI empty. Attempting failover to LIN/1082");
934 $logger->warn("EDI ORDRSP RFF/1153 unexpected value ('$val_1153', not 'LI'). Attempting failover to LIN/1082");
937 # FIXME - the line item ID in LIN/1082 ought to match RFF/1154, but
938 # not all materials vendors obey this. Commenting out check for now
939 # as being too strict.
940 #if ($id and $val_1082 and $val_1082 ne $id) {
941 # $logger->warn("EDI ORDRSP LIN/1082 Line Item ID mismatch ($id vs. $val_1082): cannot target update");
945 $id ||= $val_1082 || '';
947 $logger->warn('Cannot identify line item from EDI message');
951 $logger->info("EDI retrieve/update lineitem $id");
953 my $li = OpenILS::Application::Acq::Lineitem::retrieve_lineitem_impl($e, $id, {
954 flesh_li_details => 1,
955 }, 1); # Could send more {options}. The 1 is for no_auth.
957 if (! $li or ref($li) ne 'Fieldmapper::acq::lineitem') {
958 $logger->error("EDI failed to retrieve lineitem by id '$id' for server $server_log_string");
961 unless ((! $server) or (! $server->provider)) { # but here we want $server to be acq.edi_account instead of RemoteAccount
962 if ($server->provider != $li->provider) {
963 # links go both ways: acq.provider.edi_default and acq.edi_account.provider
964 $logger->info("EDI acct provider (" . $server->provider. ") doesn't match lineitem provider("
965 . $li->provider . "). Checking acq.provider.edi_default...");
966 my $provider = $e->retrieve_acq_provider($li->provider);
967 if ($provider->edi_default != $server->id) {
968 $logger->error(sprintf "EDI provider/acct %s/%s (%s) is blocked from updating lineitem $id belonging to provider/edi_default %s/%s",
969 $server->provider, $server->id, $server->label, $li->provider, $provider->edi_default);
975 my @lin_1229 = $line->xpath('LIN/1229') or $logger->warn("EDI LIN/1229 Action Code missing!");
976 my $key = $lin_1229[0] or return;
978 my $eg_reason = $e->retrieve_acq_cancel_reason(1000 + $key->value); # DB populated w/ spec keys in 1000's
979 $eg_reason or $logger->warn(sprintf "EDI LIN/1229 Action Code '%s' (%s) not recognized in acq.cancel_reason", $key->value, $key->label);
980 $eg_reason or return;
982 $li->cancel_reason($eg_reason->id);
983 unless ($eg_reason->keep_debits) {
984 $logger->warn("EDI LIN/1229 Action Code '%s' (%s) has keep_debits=0", $key->value, $key->label);
987 my @prices = $line->xpath_value("line_price/PRI/5118");
988 $li->estimated_unit_price($prices[0]) if @prices;
993 # caching not needed for now (edi_fetcher is asynchronous)
995 # my ($class, $key, $e) = @_;
996 # $reasons->{$key} and return $reasons->{$key};
997 # $e ||= new_editor();
998 # $reasons->{$key} = $e->retrieve_acq_cancel_reason($key);
999 # return $reasons->{$key};
1008 Note the pseudo-hash 2-element arrays.
1019 '7140' => '9780446360272',
1031 'NOT APPLIC WEBSTERS NEW WORLD THESA'