From 0f599625a46f19a25cfa81ded7ce6323f3564d20 Mon Sep 17 00:00:00 2001 From: Bill Erickson Date: Tue, 2 Oct 2012 17:11:58 -0400 Subject: [PATCH] Move to EDIReader stage 1 : ORDRSP Process order response messages via the new EDIReader module. Includes a lot of general cleanup. Note that the code is now creating a new edi_message for each message body, since a given edi message (on the wire) could in theory contain more than one message type or refer to more than one purchase order. Signed-off-by: Bill Erickson --- .../perlmods/lib/OpenILS/Application/Acq/EDI.pm | 368 +++++++++------------ 1 file changed, 165 insertions(+), 203 deletions(-) diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm index 6e9ce69d0d..09cdd87269 100644 --- a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm +++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm @@ -18,6 +18,7 @@ use OpenILS::Application::Acq::EDI::Translator; use OpenILS::Utils::LooseEDI; use Business::EDI; +use OpenILS::Utils::EDIReader; use Data::Dumper; our $verbose = 0; @@ -157,43 +158,54 @@ sub retrieve_core { # my $in = OpenILS::Application::Acq::EDI->process_retrieval($file_content, $remote_filename, $server, $account_id, $editor); sub process_retrieval { - my $incoming = Fieldmapper::acq::edi_message->new; - my ($class, $content, $remote, $server, $account_or_id, $e) = @_; + my ($class, $content, $filename, $server, $account_or_id, $e) = @_; $content or return; - $e ||= new_editor; + $e ||= new_editor; my $account = __PACKAGE__->record_activity( $account_or_id, $e ); - my $z; # must predeclare - $z = ( $content =~ s/('UNH\+\d+\+ORDRSP:)0(:96A:UN')/$1D$2/g ) - 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 + # a single EDI blob can contain multiple messages + # create one edi_message per included message - $incoming->remote_file($remote); - $incoming->account($account->id); - $incoming->edi($content); - $incoming->message_type(($content =~ /'UNH\+\d+\+(\S{6}):/) ? $1 : 'ORDRSP'); # cheap sniffing, ORDRSP fallback - __PACKAGE__->attempt_translation($incoming); - $e->xact_begin; - $e->create_acq_edi_message($incoming); - $e->xact_commit; - # refresh: send process_jedi the updated row - $e->xact_begin; + my $messages = OpenILS::Utils::EDIReader->new->read($content); + + for my $msg_hash (@$messages) { + + my $incoming = Fieldmapper::acq::edi_message->new; + + $incoming->remote_file($filename); + $incoming->account($account->id); + $incoming->edi($content); + $incoming->message_type($msg_hash->{message_type}); + $incoming->jedi(OpenSRF::Utils::JSON->perl2JSON($msg_hash)); # meh + + if ($msg_hash->{purchase_order}) { + $logger->info("EDI: processing message for PO " . $msg_hash->{purchase_order}); + $incoming->purchase_order($msg_hash->{purchase_order}); + } + + $e->xact_begin; + unless($e->create_acq_edi_message($incoming)) { + $logger->error("EDI: unable to create edi_message " . $e->die_event); + next; + } + $e->xact_commit; + + # since there's a fair chance of unhandled problems + # cropping up, particularly with new vendors, wrap w/ eval. + eval { $class->process_parsed_msg($account, $incoming, $msg_hash) }; - # LFW: I really don't understand in what sense you could call this - # message 'outgoing', except from the vendor's point of view? - my $outgoing = $e->retrieve_acq_edi_message($incoming->id); # refresh again! - $e->xact_rollback; - my $res = __PACKAGE__->process_jedi($outgoing, $server, $account, $e); - $e->xact_begin; - $outgoing = $e->retrieve_acq_edi_message($incoming->id); # refresh again! - $e->xact_rollback; - $outgoing->status($res ? 'processed' : 'proc_error'); - if ($res) { $e->xact_begin; - $e->update_acq_edi_message($outgoing); + $incoming = $e->retrieve_acq_edi_message($incoming->id); + if ($@) { + $incoming->status('proc_error'); + $incoming->error($@); + } else { + $incoming->status('processed'); + } + $e->update_acq_edi_message($incoming); $e->xact_commit; } - return $outgoing; } # ->send_core @@ -265,6 +277,7 @@ sub attempt_translation { my $tran = translator(); my $ret = $to_edi ? $tran->json2edi($edi_message->jedi) : $tran->edi2json($edi_message->edi); # $logger->error("json: " . Dumper($json)); # debugging + if (not $ret or (! ref($ret)) or $ret->is_fault) { # RPC::XML::fault on failure $edi_message->status('trans_error'); $edi_message->error_time('NOW'); @@ -273,11 +286,13 @@ sub attempt_translation { ("$pre, Error " . $ret->code . ": " . __PACKAGE__->nice_string($ret->string)) : ("$pre: " . __PACKAGE__->nice_string($ret) ) ; $edi_message->error($message); - $logger->error( $message); + $logger->error($message); return; } + $edi_message->status('translated'); $edi_message->translate_time('NOW'); + if ($to_edi) { $edi_message->edi($ret->value); # translator returns an object } else { @@ -410,199 +425,146 @@ sub jedi2perl { our @datecodes = (35, 359, 17, 191, 69, 76, 75, 79, 85, 74, 84, 223); our @noop_6063 = (21); -# ->process_jedi($message, $server, $remote, $e) -# $message is an edi_message object -# -# This method has lots of logic to process ORDRSP messages (and theoretically -# OSTRPT messages) and to make changes based on those to EG acq objects. -# If it gets an INVOIC message, it hands that off to -# create_acq_invoice_from_edi() following a new model (this code all wants -# cleaned-up/refactored). -# -# This method currently returns an array of message objects, but no callers use -# that except in a boolean evaluation to test for success. So don't count on -# that array being there or containing anything specific in the future: it -# might get changed. -sub process_jedi { - my ($class, $message, $server, $remote, $e) = @_; - $message or return; - $server ||= {}; # context - $remote ||= {}; # context - $e ||= new_editor; - my $jedi; - unless (ref($message) and $jedi = $message->jedi) { # assignment, not comparison - $logger->warn("EDI process_jedi missing required argument (edi_message object with jedi)!"); - return; - } - my $perl = __PACKAGE__->jedi2perl($jedi); - my $error = ''; - if (ref($message) and not $perl) { - $error = ($message->error || '') . " JSON2perl (jedi2perl) FAILED to convert jedi"; - } - elsif (! $perl->{body}) { - $error = "EDI interchange body not found!"; - } - elsif (! $perl->{body}->[0]) { - $error = "EDI interchange body not a populated arrayref!"; - } - if ($error) { - $logger->warn($error); - $message->error($error); - $message->error_time('NOW'); - $e->xact_begin; - $e->update_acq_edi_message($message) or $logger->warn("EDI update_acq_edi_message failed! $!"); - $e->xact_commit; +# parts of this process can fail without the entire +# thing failing. If a catastrophic error occurs, +# it will occur via die. +sub process_parsed_msg { + my ($class, $account, $incoming, $msg_hash) = @_; + + if ($incoming->message_type eq 'INVOIC') { + # handle invoice return; } -# Crazy data structure. Most of the arrays will be 1 element... we think. -# JEDI looks like: -# {'body' => [{'ORDERS' => [['UNH',{'0062' => '4635','S009' => {'0057' => 'EAN008','0051' => 'UN','0052' => 'D','0065' => 'ORDERS', ... -# -# So you might access it like: -# $obj->{body}->[0]->{ORDERS}->[0]->[0] eq 'UNH' - - $logger->info("EDI interchange body has " . scalar(@{$perl->{body}}) . " message(s)"); - my @ok_msg_codes = qw/ORDRSP OSTRPT INVOIC/; - my @messages; - my $i = 0; - foreach my $part (@{$perl->{body}}) { - $i++; - unless (ref $part and scalar keys %$part) { - $logger->warn("EDI interchange message $i lacks structure. Skipping it."); + for my $li_hash (@{$msg_hash->{lineitems}}) { + my $e = new_editor(xact => 1); + + my $li_id = $li_hash->{id}; + my $li = $e->retrieve_acq_lineitem($li_id); + + if (!$li) { + $logger->error("EDI: reqest for invalid lineitem ID '$li_id'"); + $e->rollback; next; } - foreach my $key (keys %$part) { - if (! grep {$_ eq $key} @ok_msg_codes) { # We only do one type for now. TODO: other types here - $logger->warn("EDI interchange $i contains unhandled '$key' message. Ignoring it."); + + if ($li_hash->{expected_date}) { + my ($y, $m, $d) = $li_hash->{expected_date} =~ /^(\d{4})(\d{2})(\d{2})/g; + my $recv_time = $y; + $recv_time .= "-$m" if $m; + $recv_time .= "-$d" if $d; + $li->expected_recv_time($recv_time); + } + + $li->estimated_unit_price($li_hash->{unit_price}); + + if (not $incoming->purchase_order) { + # PO should come from the EDI message, but if not... + + # fetch the latest copy + $incoming = $e->retrieve_acq_edi_message($incoming->id); + $incoming->purchase_order($li->purchase_order); + + unless($e->update_acq_edi_message($incoming)) { + $logger->error("EDI: unable to update edi_message " . $e->die_event); next; } - if ($key eq 'INVOIC') { - # XXX TODO Maybe subclass O::U::LooseEDI::Message as - # something like OpenILS::Acq::{VendorInvoice,OrderReponse}, - # each one knowing how to read itself and update EG acq - # objects (not under OpenILS::Application perhaps). - my $invoice_message = - new OpenILS::Utils::LooseEDI::Message($part->{$key}); - push @messages, $invoice_message if - $class->create_acq_invoice_from_edi( - $e, $invoice_message, $remote->provider, $message - ); + } + + my $lids = $e->json_query({ + select => {acqlid => ['id']}, + from => 'acqlid', + where => { lineitem => $li->id } + }); + + my @lids = map { $_->{id} } @$lids; + my $lid_count = scalar(@lids); + my $lids_covered = 0; + my $lids_touched = 0; + + for my $qty (@{$li_hash->{quantities}}) { + + my $qty_count = $qty->{quantity} or next; + my $qty_code = $qty->{code}; + + if (!$qty_code) { + $logger->warn("EDI: Response for LI $li_id specifies quantity ". + "$qty_count with no 6063 code! Contact vendor to resolve."); next; } - my $msg = __PACKAGE__->message_object($part->{$key}) or next; - push @messages, $msg; + $logger->info("EDI: LI $li_id processing quantity count=$qty_count / code=$qty_code"); - my $bgm = $msg->xpath('BGM') or $logger->warn("EDI No BGM segment found?!"); - my $tag4343 = $msg->xpath('BGM/4343'); - my $tag1225 = $msg->xpath('BGM/1225'); - if (ref $tag4343) { - $logger->info(sprintf "EDI $key BGM/4343 Response Type: %s - %s", $tag4343->value, $tag4343->label) - } else { - $logger->warn("EDI $key BGM/4343 Response Type Code unrecognized"); # next; #? - } - if (ref $tag1225) { - $logger->info(sprintf "EDI $key BGM/1225 Message Function: %s - %s", $tag1225->value, $tag1225->label); - } else { - $logger->warn("EDI $key BGM/1225 Message Function Code unrecognized"); # next; #? + if ($qty_code eq '21') { # "ordered quantity" + $logger->info("EDI: LI $li_id -- vendor confirms $qty_count ordered"); + $logger->warn("EDI: LI $li_id -- order count $qty_count ". + "does not match LID count $lid_count") unless $qty_count == $lid_count; + next; } - # TODO: currency check, just to be paranoid - # *should* be unnecessary (vendor should reply in currency we send in ORDERS) - # That begs a policy question: how to handle mismatch? convert (bad accuracy), reject, or ignore? I say ignore. - - # ALL those codes below are basically some form of (lastest) delivery date/time - # see, e.g.: http://www.stylusstudio.com/edifact/D04B/2005.htm - # The order is the order of definitiveness (first match wins) - # Note: if/when we do serials via EDI, dates (and ranges/periods) will need massive special handling - my @dates; - my $ddate; - - foreach my $date ($msg->xpath('delivery_schedule')) { - my $val_2005 = $date->xpath_value('DTM/2005') or next; - (grep {$val_2005 eq $_} @datecodes) or next; # no match means some other kind of date we don't care about - push @dates, $date; - } - if (@dates) { - DATECODE: foreach my $dcode (@datecodes) { # now cycle back through hits in order of dcode definitiveness - foreach my $date (@dates) { - $date->xpath_value('DTM/2005') == $dcode or next; - $ddate = $date->xpath_value('DTM/2380') and last DATECODE; - # TODO: conversion based on format specified in DTM/2379 (best encapsulated in Business::EDI) - } - } + $lids_covered += $qty_count; + + if ($qty_code eq '12') { + $logger->info("EDI: LI $li_id -- vendor dispatched $qty_count"); + next; + + } elsif ($qty_code eq '57') { + $logger->info("EDI: LI $li_id -- $qty_count in transit"); + next; } - foreach my $detail ($msg->part('line_detail')) { - my $eg_line = __PACKAGE__->eg_li($detail, $remote, $server->{remote_host}, $e) or next; - my $li_date = $detail->xpath_value('DTM/2380') || $ddate; - my $price = $detail->xpath_value('line_price/PRI/5118') || ''; - $eg_line->expected_recv_time($li_date) if $li_date; - $eg_line->estimated_unit_price($price) if $price; - if (not $message->purchase_order) { # first good lineitem sets the message PO link - $message->purchase_order($eg_line->purchase_order); # EG $message object NOT Business::EDI $msg object - $e->xact_begin; - $e->update_acq_edi_message($message) or $logger->warn("EDI update_acq_edi_message (for PO number) failed! $!"); - $e->xact_commit; + # 84: urgent delivery + # 118: quantity manifested + # ... + + # ------------------------------------------------------------------------- + # All of the remaining quantity types require that we apply a cancel_reason + # DB populated w/ 6063 keys in 1200's + + my $eg_reason = $e->retrieve_acq_cancel_reason(1200 + $qty_code); + + if (!$eg_reason) { + $logger->warn("EDI: Unhandled quantity qty_code '$qty_code' ". + "for li $li_id. $qty_count items unprocessed"); + next; + } + + my $break = 0; + foreach (1 .. $qty_count) { + + my $lid_id = shift @lids; + if (!$lid_id) { + $logger->warn("EDI: Used up all $lid_count LIDs. ". + "Ignoring extra status '" . $eg_reason->label . "'"); + last; } - # $e->search_acq_edi_account([]); - my $touches = 0; - my $eg_lids = $e->search_acq_lineitem_detail({lineitem => $eg_line->id}); # should be the same as $eg_line->lineitem_details - my $lidcount = scalar(@$eg_lids); - $lidcount == $eg_line->item_count or $logger->warn( - sprintf "EDI: LI %s itemcount (%d) mismatch, %d LIDs found", $eg_line->id, $eg_line->item_count, $lidcount - ); - foreach my $qty ($detail->part('all_QTY')) { - my $ubound = $qty->xpath_value('6060') or next; # nothing to do if qty is 0 - my $val_6063 = $qty->xpath_value('6063'); - $ubound > 0 or next; # don't be crazy! - if (! $val_6063) { - $logger->warn("EDI: Response for LI " . $eg_line->id . " specifies quantity $ubound with no 6063 code! Contact vendor to resolve."); - next; - } - - my $eg_reason = $e->retrieve_acq_cancel_reason(1200 + $val_6063); # DB populated w/ 6063 keys in 1200's - if (! $eg_reason) { - $logger->warn("EDI: Unhandled quantity code '$val_6063' (LI " . $eg_line->id . ") $ubound items unprocessed"); - next; - } elsif (grep {$val_6063 == $_} @noop_6063) { # an FYI like "ordered quantity" - $ubound eq $lidcount - or $logger->warn("EDI: LI " . $eg_line->id . " -- Vendor says we ordered $ubound, but we have $lidcount LIDs!)"); - next; - } - # elsif ($val_6063 == 83) { # backorder - #} elsif ($val_6063 == 85) { # cancel - #} elsif ($val_6063 == 12 or $val_6063 == 57 or $val_6063 == 84 or $val_6063 == 118) { - # despatched, in transit, urgent delivery, or quantity manifested - #} - if ($touches >= $lidcount) { - $logger->warn("EDI: LI " . $eg_line->id . ", We already updated $touches of $lidcount LIDS, " . - "but message wants QTY $ubound more set to " . $eg_reason->label . ". Ignoring!"); - next; - } - $e->xact_begin; - foreach (1 .. $ubound) { - my $eg_lid = shift @$eg_lids or $logger->warn("EDI: Used up all $lidcount LIDs! Ignoring extra status " . $eg_reason->label); - $eg_lid or next; - $logger->debug(sprintf "Updating LID %s to %s", $eg_lid->id, $eg_reason->label); - $eg_lid->cancel_reason($eg_reason->id); - $e->update_acq_lineitem_detail($eg_lid); - $touches++; - } - $e->xact_commit; - if ($ubound == $eg_line->item_count) { - $eg_line->cancel_reason($eg_reason->id); # if ALL the items have the same cancel_reason, the PO gets it too - } + + my $lid = $e->retrieve_acq_lineitem_detail($lid_id); + $lid->cancel_reason($eg_reason->id); + $e->update_acq_lineitem_detail($lid); + $lids_touched++; + + # if ALL the items have the same cancel_reason, the LI gets it too + $li->cancel_reason($eg_reason->id) if $qty_count == $lid_count; + + $li->edit_time('now'); + unless ($e->update_acq_lineitem($li)) { + $logger->error("EDI: update_acq_lineitem failed " . $e->die_event); + $break = 1; + last; } - $eg_line->edit_time('NOW'); # TODO: have this field automatically updated via ON UPDATE trigger. - $e->xact_begin; - $e->update_acq_lineitem($eg_line) or $logger->warn("EDI: update_acq_lineitem FAILED"); - $e->xact_commit; - # print STDERR "Lineitem update: ", Dumper($eg_line); } + + # non-recoverable transaction error + # note in this case the commit below will be a silent no-op + last if $break; } + + # LI and LIDs updated, let's wrap this one up. + $e->commit; + + $logger->info("EDI LI $li_id -- $lids_covered LIDs mentioned; ". + "$lids_touched LIDs had cancel_reason's applied"); } - return \@messages; } -- 2.11.0