[open-ils-commits] [GIT] Evergreen ILS branch rel_2_3 updated. a53c643f54bdb34db7d2b3e3cb9e6974a873f4a8
Evergreen Git
git at git.evergreen-ils.org
Mon Jan 14 17:14:03 EST 2013
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Evergreen ILS".
The branch, rel_2_3 has been updated
via a53c643f54bdb34db7d2b3e3cb9e6974a873f4a8 (commit)
via 17431bb096ce0818310a166b1feffeba83b654d4 (commit)
via 676143704be517eb47ef4ce410ee73dc68576cd8 (commit)
via 028d8d3d529e3ad96a464a59398ee0c2590539a7 (commit)
via 2eb7bb6d2b1827a10d6937ae027275f889117f94 (commit)
via c9e1e9fc06e9f2f1f9a2e4e7a771556da074bd95 (commit)
via a5aad2e6840359f65a278406da3a0f250f93e20b (commit)
via b82675e26f0ad627a7276865a9fccb2a6d27fd33 (commit)
via 721781979545d0a9fdb335de706d58b07cbf0ba2 (commit)
via e52692104abeaf6da197c2b010f64f2e4b3ccadf (commit)
from 56dfac8d77fd0e309ca3bf09946389abecd652c2 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit a53c643f54bdb34db7d2b3e3cb9e6974a873f4a8
Author: Lebbeous Fogle-Weekley <lebbeous at esilibrary.com>
Date: Mon Jan 14 16:59:12 2013 -0500
Upgrade script numbering for edireader branch
Signed-off-by: Lebbeous Fogle-Weekley <lebbeous at esilibrary.com>
diff --git a/Open-ILS/src/sql/Pg/002.schema.config.sql b/Open-ILS/src/sql/Pg/002.schema.config.sql
index f8128a6..25fa292 100644
--- a/Open-ILS/src/sql/Pg/002.schema.config.sql
+++ b/Open-ILS/src/sql/Pg/002.schema.config.sql
@@ -87,7 +87,7 @@ CREATE TRIGGER no_overlapping_deps
BEFORE INSERT OR UPDATE ON config.db_patch_dependencies
FOR EACH ROW EXECUTE PROCEDURE evergreen.array_overlap_check ('deprecates');
-INSERT INTO config.upgrade_log (version, applied_to) VALUES ('0750', :eg_version); -- miker/jstephenson
+INSERT INTO config.upgrade_log (version, applied_to) VALUES ('0751', :eg_version); -- berick/senator
CREATE TABLE config.bib_source (
id SERIAL PRIMARY KEY,
diff --git a/Open-ILS/src/sql/Pg/upgrade/XXXX.data.acq_cancel_not_accepted.sql b/Open-ILS/src/sql/Pg/upgrade/0751.data.acq_cancel_not_accepted.sql
similarity index 78%
rename from Open-ILS/src/sql/Pg/upgrade/XXXX.data.acq_cancel_not_accepted.sql
rename to Open-ILS/src/sql/Pg/upgrade/0751.data.acq_cancel_not_accepted.sql
index e8ed2a8..5e0d22b 100644
--- a/Open-ILS/src/sql/Pg/upgrade/XXXX.data.acq_cancel_not_accepted.sql
+++ b/Open-ILS/src/sql/Pg/upgrade/0751.data.acq_cancel_not_accepted.sql
@@ -1,5 +1,6 @@
BEGIN;
+SELECT evergreen.upgrade_deps_block_check('0751', :eg_version);
INSERT INTO acq.cancel_reason (keep_debits, id, org_unit, label, description)
VALUES (
commit 17431bb096ce0818310a166b1feffeba83b654d4
Author: Bill Erickson <berick at esilibrary.com>
Date: Wed Dec 26 16:27:38 2012 -0500
EDIReader release notes
Signed-off-by: Bill Erickson <berick at esilibrary.com>
Signed-off-by: Lebbeous Fogle-Weekley <lebbeous at esilibrary.com>
diff --git a/docs/RELEASE_NOTES_NEXT/edireader.txt b/docs/RELEASE_NOTES_NEXT/edireader.txt
new file mode 100644
index 0000000..7354200
--- /dev/null
+++ b/docs/RELEASE_NOTES_NEXT/edireader.txt
@@ -0,0 +1,28 @@
+EDI Fetching and Parsing Enhancements / Repairs
+===============================================
+This release includes various improvements to how Evergreen processes
+vendor EDI responses, including order responses and invoices. Changes
+include architectural improvements as well as new features.
+
+Bug Fixes
+---------
+
+* Improved order response handling for cancelled items.
+* Deleting fund debits (encumbrances) for cancelled items.
+* Extracting invoice date
+* Invoices include quantity and amount paid (in addition to billed) to reduce
+ manual staff data entry
+* Proper handling of previously-cancelled (e.g. back-ordered) invoiced items.
+
+Architectural improvements
+--------------------------
+
+For EDI parsing, the Ruby libraries, Ruby HTTP gateway, and Business::EDI Perl
+modules are no longer needed. They have been replaced with a single Perl
+module which handles EDI parsing.
+
+This reduces the complexity of the fetching and parsing layer. Though the Ruby
+libraries and Ruby HTTP gateway are still needed for outbound EDI (for now),
+the Perl Business::EDI modules are no longer needed at all, so they are no
+longer installed.
+
commit 676143704be517eb47ef4ce410ee73dc68576cd8
Author: Bill Erickson <berick at esilibrary.com>
Date: Thu Dec 13 09:44:55 2012 -0500
Handle cancelled (back-order) lineitems in EDI invoice
Receiving an invoice for a cancelled lineitem mean the lineitem is no
longer cancelled. Identify such lineitems and uncancel them along with
the requested number of not-yet-invoiced copies.
This work flow is common for back-order items.
Signed-off-by: Bill Erickson <berick at esilibrary.com>
Signed-off-by: Lebbeous Fogle-Weekley <lebbeous at esilibrary.com>
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 7a6b4f4..d898a8c 100644
--- a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm
@@ -761,6 +761,7 @@ sub create_acq_invoice_from_edi {
}
my @eg_inv_entries;
+ my @eg_inv_cancel_lis;
$message->purchase_order($invoice->{purchase_order});
@@ -817,6 +818,9 @@ sub create_acq_invoice_from_edi {
$eg_inv_entry->amount_paid($lineitem_price);
push @eg_inv_entries, $eg_inv_entry;
+ push @eg_inv_cancel_lis,
+ {lineitem => $li, quantity => $quantity}
+ if $li->cancel_reason;
}
my @eg_inv_items;
@@ -898,6 +902,68 @@ sub create_acq_invoice_from_edi {
}
}
+ # if an invoiced lineitem is marked as cancelled
+ # (e.g. back-order), invoicing the lineitem implies
+ # we need to un-cancel it
+ for my $li_chunk (@eg_inv_cancel_lis) {
+ my $li = $li_chunk->{lineitem};
+ my $quantity = $li_chunk->{quantity};
+
+ $logger->info($log_prefix .
+ "un-cancelling invoiced lineitem ". $li->id);
+
+ # collect the LIDs, starting with those that are
+ # not cancelled (should not happen), followed by
+ # those that have keep-debits cancel_reasons,
+ # followed by non-keep-debit cancel reasons.
+
+ my $lid_ids = $e->json_query({
+ select => {acqlid => ['id']},
+ from => {
+ acqlid => {
+ acqcr => {type => 'left'},
+ acqfdeb => {type => 'left'}
+ }
+ },
+ where => {
+ '+acqlid' => {lineitem => $li->id},
+ # not-yet invoiced copies
+ '+acqfdeb' => {encumbrance => 't'}
+ },
+ order_by => [{
+ class => 'acqcr',
+ field => 'keep_debits',
+ direction => 'desc'
+ }],
+ limit => $quantity
+ });
+
+ for my $lid_id (map {$_->{id}} @$lid_ids) {
+ my $lid = $e->retrieve_acq_lineitem_detail($lid_id);
+ next unless $lid->cancel_reason;
+
+ $lid->clear_cancel_reason;
+ unless ($e->update_acq_lineitem_detail($lid)) {
+ $logger->error($log_prefix .
+ "couldn't clear lid cancel reason: ". $e->die_event
+ );
+ return 0;
+ }
+ }
+
+ $li->clear_cancel_reason;
+ $li->state("on-order");
+ $li->edit_time('now');
+
+ unless ($e->update_acq_lineitem($li)) {
+ $logger->error($log_prefix .
+ "couldn't clear li cancel reason: ". $e->die_event
+ );
+ return 0;
+ }
+ }
+
+
$e->xact_commit;
return 1;
}
commit 028d8d3d529e3ad96a464a59398ee0c2590539a7
Author: Bill Erickson <berick at esilibrary.com>
Date: Wed Dec 12 12:50:47 2012 -0500
EDIReader: improve monetary regexes
Make no attempt to enforce/decipher monetary amounts in the regexes,
simply capture the values. If they are invalid, Postgres will let us
know.
This change allows us to capture non-numeric (\d) characters (e.g. "."),
which are of course common in monetary amounts.
Signed-off-by: Bill Erickson <berick at esilibrary.com>
Signed-off-by: Lebbeous Fogle-Weekley <lebbeous at esilibrary.com>
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm
index 532af2d..7096883 100644
--- a/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm
@@ -26,16 +26,16 @@ my %edi_fields = (
vendor_acct => qr/^NAD\+SU\+([^:]+)::91/,
purchase_order => qr/^RFF\+ON:(\S+)/,
invoice_ident => qr/^BGM\+380\+([^\+]+)/,
- total_billed => qr/^MOA\+86:(\d+)/,
+ total_billed => qr/^MOA\+86:([^:]+)/,
invoice_date => qr/^DTM\+137:([^:]+)/
);
my %edi_li_fields = (
id => qr/^RFF\+LI:\S+\/(\S+)/,
index => qr/^LIN\+([^\+]+)/,
- amount_billed => qr/^MOA\+203:(\d+)/,
- net_unit_price => qr/^PRI\+AAA:(\d+)/,
- gross_unit_price=> qr/^PRI\+AAB:(\d+)/,
+ amount_billed => qr/^MOA\+203:([^:]+)/,
+ net_unit_price => qr/^PRI\+AAA:([^:]+)/,
+ gross_unit_price=> qr/^PRI\+AAB:([^:]+)/,
expected_date => qr/^DTM\+44:([^:]+)/,
avail_status => qr/^FTX\+LIN\++([^:]+):8B:28/,
# "1B" codes are deprecated, but still in use.
@@ -55,7 +55,7 @@ my %edi_li_quant_fields = (
my %edi_charge_fields = (
charge_type => qr/^ALC\+C\++([^\+]+)/,
- charge_amount => qr/^MOA\+(8|131):(\d+)/
+ charge_amount => qr/^MOA\+(8|131):([^:]+)/
);
sub new {
commit 2eb7bb6d2b1827a10d6937ae027275f889117f94
Author: Bill Erickson <berick at esilibrary.com>
Date: Wed Dec 5 09:34:00 2012 -0500
EDI invoice date; invoice paid quantity/amount
* capture the invoice date in EDIReader
* apply the invoice date to inbound invoices when available instead of
defaulting to 'now'
* apply the quantity/amount billed to the quantity/amount paid to reduce
staff data entry needs
Signed-off-by: Bill Erickson <berick at esilibrary.com>
Signed-off-by: Lebbeous Fogle-Weekley <lebbeous at esilibrary.com>
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 09b6ce2..7a6b4f4 100644
--- a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm
@@ -449,13 +449,8 @@ sub process_parsed_msg {
next;
}
- 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->expected_recv_time(
+ $class->edi_date_to_iso($li_hash->{expected_date}));
$li->estimated_unit_price($li_hash->{unit_price});
@@ -681,6 +676,15 @@ sub cancel_lids {
return ($cancel_count);
}
+sub edi_date_to_iso {
+ my ($class, $date) = @_;
+ return undef unless $date and $date =~ /\d+/;
+ my ($iso, $m, $d) = $date =~ /^(\d{4})(\d{2})(\d{2})/g;
+ $iso .= "-$m" if $m;
+ $iso .= "-$d" if $d;
+ return $iso;
+}
+
# create_acq_invoice_from_edi() does what it sounds like it does for INVOIC
# messages. For similar operation on ORDRSP messages, see the guts of
@@ -704,6 +708,9 @@ sub create_acq_invoice_from_edi {
# distinguish provider and shipper?
$eg_inv->recv_method("EDI");
+ $eg_inv->recv_date(
+ $class->edi_date_to_iso($invoice->{invoice_date}));
+
# some vendors encode the account number as the SAN.
# starting with the san value, then the account value,
@@ -793,6 +800,9 @@ sub create_acq_invoice_from_edi {
my $eg_inv_entry = Fieldmapper::acq::invoice_entry->new;
$eg_inv_entry->inv_item_count($quantity);
+ # amount staff agree to pay for
+ $eg_inv_entry->phys_item_count($quantity);
+
# XXX Validate by making sure the LI is on-order and belongs to
# the right provider and ordering agency and all that.
$eg_inv_entry->lineitem($li_id);
@@ -803,6 +813,9 @@ sub create_acq_invoice_from_edi {
# This is the total price for all units billed, not per-unit.
$eg_inv_entry->cost_billed($lineitem_price);
+ # amount staff agree to pay
+ $eg_inv_entry->amount_paid($lineitem_price);
+
push @eg_inv_entries, $eg_inv_entry;
}
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm
index e6c872e..532af2d 100644
--- a/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm
@@ -26,7 +26,8 @@ my %edi_fields = (
vendor_acct => qr/^NAD\+SU\+([^:]+)::91/,
purchase_order => qr/^RFF\+ON:(\S+)/,
invoice_ident => qr/^BGM\+380\+([^\+]+)/,
- total_billed => qr/^MOA\+86:(\d+)/
+ total_billed => qr/^MOA\+86:(\d+)/,
+ invoice_date => qr/^DTM\+137:([^:]+)/
);
my %edi_li_fields = (
commit c9e1e9fc06e9f2f1f9a2e4e7a771556da074bd95
Author: Bill Erickson <berick at esilibrary.com>
Date: Tue Dec 4 10:00:26 2012 -0500
EDI: ensure lineitem 'state' matches cancel state
When cancelling a lineitem becuase all linked copies are cancelled,
ensure that the lineitem state is set to "cancelled".
Signed-off-by: Bill Erickson <berick at esilibrary.com>
Signed-off-by: Lebbeous Fogle-Weekley <lebbeous at esilibrary.com>
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 dbabd25..09b6ce2 100644
--- a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm
@@ -543,7 +543,10 @@ sub process_parsed_msg {
$lids_cancelled += $cancel_count;
# 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;
+ if ($qty_count == $lid_count) {
+ $li->cancel_reason($eg_reason->id);
+ $li->state("cancelled");
+ }
$li->edit_time('now');
unless ($e->update_acq_lineitem($li)) {
@@ -604,8 +607,11 @@ sub process_parsed_msg {
# All LIDs cancelled with same reason, apply
# the same cancel reason to the lineitem
- $li->cancel_reason($reason->id) if $remaining_lids == $order_qty;
-
+ if ($remaining_lids == $order_qty) {
+ $li->cancel_reason($reason->id);
+ $li->state("cancelled");
+ }
+
$li->edit_time('now');
unless ($e->update_acq_lineitem($li)) {
$logger->error("EDI: update_acq_lineitem failed " . $e->die_event);
commit a5aad2e6840359f65a278406da3a0f250f93e20b
Author: Bill Erickson <berick at esilibrary.com>
Date: Mon Dec 3 14:51:41 2012 -0500
EDI response honor lineitem-level status; debit cleanup
* Honor lineitem-level order status info (FTX+LIN) which indicates, in
some cases, that all ordered copies should be cancelled because the LI
as a whole is cancelled
* Delete fund debits for cancelled lineitem details when appropriate
Signed-off-by: Bill Erickson <berick at esilibrary.com>
Signed-off-by: Lebbeous Fogle-Weekley <lebbeous at esilibrary.com>
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 1ed4697..dbabd25 100644
--- a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm
@@ -15,6 +15,8 @@ use OpenILS::Utils::RemoteAccount;
use OpenILS::Utils::CStoreEditor q/new_editor/;
use OpenILS::Utils::Fieldmapper;
use OpenILS::Application::Acq::EDI::Translator;
+use OpenILS::Application::AppUtils;
+my $U = 'OpenILS::Application::AppUtils';
use OpenILS::Utils::EDIReader;
@@ -442,7 +444,7 @@ sub process_parsed_msg {
my $li = $e->retrieve_acq_lineitem($li_id);
if (!$li) {
- $logger->error("EDI: reqest for invalid lineitem ID '$li_id'");
+ $logger->error("EDI: request for invalid lineitem ID '$li_id'");
$e->rollback;
next;
}
@@ -473,19 +475,23 @@ sub process_parsed_msg {
my $lids = $e->json_query({
select => {acqlid => ['id']},
from => 'acqlid',
- where => { lineitem => $li->id }
+ where => {lineitem => $li->id}
});
my @lids = map { $_->{id} } @$lids;
my $lid_count = scalar(@lids);
my $lids_covered = 0;
- my $lids_touched = 0;
-
+ my $lids_cancelled = 0;
+ my $order_qty;
+ my $dispatch_qty;
+
for my $qty (@{$li_hash->{quantities}}) {
- my $qty_count = $qty->{quantity} or next;
+ my $qty_count = $qty->{quantity};
my $qty_code = $qty->{code};
+ next unless defined $qty_count;
+
if (!$qty_code) {
$logger->warn("EDI: Response for LI $li_id specifies quantity ".
"$qty_count with no 6063 code! Contact vendor to resolve.");
@@ -495,6 +501,7 @@ sub process_parsed_msg {
$logger->info("EDI: LI $li_id processing quantity count=$qty_count / code=$qty_code");
if ($qty_code eq '21') { # "ordered quantity"
+ $order_qty = $qty_count;
$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;
@@ -504,6 +511,7 @@ sub process_parsed_msg {
$lids_covered += $qty_count;
if ($qty_code eq '12') {
+ $dispatch_qty = $qty_count;
$logger->info("EDI: LI $li_id -- vendor dispatched $qty_count");
next;
@@ -527,43 +535,144 @@ sub process_parsed_msg {
next;
}
- my $break = 0;
- foreach (1 .. $qty_count) {
+ my ($cancel_count, $fatal) =
+ $class->cancel_lids($e, $eg_reason, $qty_count, $lid_count, \@lids);
- my $lid_id = shift @lids;
- if (!$lid_id) {
- $logger->warn("EDI: Used up all $lid_count LIDs. ".
- "Ignoring extra status '" . $eg_reason->label . "'");
- last;
- }
+ last if $fatal;
- my $lid = $e->retrieve_acq_lineitem_detail($lid_id);
- $lid->cancel_reason($eg_reason->id);
- $e->update_acq_lineitem_detail($lid);
- $lids_touched++;
+ $lids_cancelled += $cancel_count;
- # 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;
+ # 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;
- }
+ $li->edit_time('now');
+ unless ($e->update_acq_lineitem($li)) {
+ $logger->error("EDI: update_acq_lineitem failed " . $e->die_event);
+ last;
}
+ }
+
+ # in case the provider neglected to echo back the order count
+ $order_qty = $lid_count unless defined $order_qty;
+
+ # it may be necessary to change the logic here to look for lineitem
+ # order status / availability status instead of dispatch_qty and
+ # assume that dispatch_qty simply equals the number of unaccounted-for copies
+ if (defined $dispatch_qty) {
+ # provider is telling us how may copies were delivered
+
+ # number of copies neither cancelled or delivered
+ my $remaining_lids = $order_qty - ($dispatch_qty + $lids_cancelled);
+
+ if ($remaining_lids > 0) {
+
+ # the vendor did not ship all items and failed to provide cancellation
+ # quantities for some or all of the items to be cancelled. When this
+ # happens, we cancel the remaining un-delivered copies using the
+ # lineitem order status to determine the cancel reason.
+
+ my $reason_id;
+ my $stat;
+
+ if ($stat = $li_hash->{order_status}) {
+ $logger->info("EDI: lineitem has order status $stat");
+
+ if ($stat eq '200') {
+ $reason_id = 1007; # not accepted
+
+ } elsif ($stat eq '400') {
+ $reason_id = 1283; # back-order
+ }
+
+ } elsif ($stat = $li_hash->{avail_status}) {
+ $logger->info("EDI: lineitem has availability status $stat");
+
+ if ($stat eq 'NP') {
+ # not yet published
+ # TODO: needs cancellation?
+ }
+ }
+
+ if ($reason_id) {
+ my $reason = $e->retrieve_acq_cancel_reason($reason_id);
+
+ my ($cancel_count, $fatal) =
+ $class->cancel_lids($e, $reason, $remaining_lids, $lid_count, \@lids);
+
+ last if $fatal;
+ $lids_cancelled += $cancel_count;
+
+ # All LIDs cancelled with same reason, apply
+ # the same cancel reason to the lineitem
+ $li->cancel_reason($reason->id) if $remaining_lids == $order_qty;
+
+ $li->edit_time('now');
+ unless ($e->update_acq_lineitem($li)) {
+ $logger->error("EDI: update_acq_lineitem failed " . $e->die_event);
+ last;
+ }
- # non-recoverable transaction error
- # note in this case the commit below will be a silent no-op
- last if $break;
+ } else {
+ $logger->warn("EDI: vendor says we ordered $order_qty and cancelled ".
+ "$lids_cancelled, but only shipped $dispatch_qty");
+ }
+ }
}
# LI and LIDs updated, let's wrap this one up.
+ # this is a no-op if the xact has already been rolled back
$e->commit;
- $logger->info("EDI LI $li_id -- $lids_covered LIDs mentioned; ".
- "$lids_touched LIDs had cancel_reason's applied");
+ $logger->info("EDI: LI $li_id -- $order_qty LIDs ordered; ".
+ "$lids_cancelled LIDs cancelled");
+ }
+}
+
+sub cancel_lids {
+ my ($class, $e, $reason, $count, $lid_count, $lid_ids) = @_;
+
+ my $cancel_count = 0;
+
+ foreach (1 .. $count) {
+
+ my $lid_id = shift @$lid_ids;
+
+ if (!$lid_id) {
+ $logger->warn("EDI: Used up all $lid_count LIDs. ".
+ "Ignoring extra status '" . $reason->label . "'");
+ last;
+ }
+
+ my $lid = $e->retrieve_acq_lineitem_detail($lid_id);
+ $lid->cancel_reason($reason->id);
+
+ # item is cancelled. Remove the fund debit.
+ unless ($U->is_true($reason->keep_debits)) {
+
+ if (my $debit_id = $lid->fund_debit) {
+
+ $lid->clear_fund_debit;
+ my $debit = $e->retrieve_acq_fund_debit($debit_id);
+
+ if ($U->is_true($debit->encumbrance)) {
+ $logger->info("EDI: deleting debit $debit_id for cancelled LID $lid_id");
+
+ unless ($e->delete_acq_fund_debit($debit)) {
+ $logger->error("EDI: unable to update fund_debit " . $e->die_event);
+ return (0, 1);
+ }
+ } else {
+ # do not delete a paid-for debit
+ $logger->warn("EDI: cannot delete invoiced debit $debit_id");
+ }
+ }
+ }
+
+ $e->update_acq_lineitem_detail($lid);
+ $cancel_count++;
}
+
+ return ($cancel_count);
}
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm
index d3b5697..e6c872e 100644
--- a/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm
@@ -35,7 +35,11 @@ my %edi_li_fields = (
amount_billed => qr/^MOA\+203:(\d+)/,
net_unit_price => qr/^PRI\+AAA:(\d+)/,
gross_unit_price=> qr/^PRI\+AAB:(\d+)/,
- expected_date => qr/^DTM\+44:([^:]+)/
+ expected_date => qr/^DTM\+44:([^:]+)/,
+ avail_status => qr/^FTX\+LIN\++([^:]+):8B:28/,
+ # "1B" codes are deprecated, but still in use.
+ # Pretend it's "12B" and it should just work
+ order_status => qr/^FTX\+LIN\++([^:]+):12?B:28/
);
my %edi_li_ident_fields = (
diff --git a/Open-ILS/src/sql/Pg/950.data.seed-values.sql b/Open-ILS/src/sql/Pg/950.data.seed-values.sql
index 12ac691..c154b2c 100644
--- a/Open-ILS/src/sql/Pg/950.data.seed-values.sql
+++ b/Open-ILS/src/sql/Pg/950.data.seed-values.sql
@@ -8745,6 +8745,7 @@ INSERT INTO acq.cancel_reason (keep_debits, id, org_unit, label, description) VA
('t',( 3+1000), 1, 'Changed', 'The information is to be or has been changed.'),
('t',( 4+1000), 1, 'No action', 'This line item is not affected by the actual message.'),
('t',( 5+1000), 1, 'Accepted without amendment', 'This line item is entirely accepted by the seller.'),
+('f',( 7+1000), 1, 'Not accepted', 'This line item is not accepted by the seller.'),
('f',( 10+1000), 1, 'Not found', 'This line item is not found in the referenced message.'),
('t',( 24+1000), 1, 'Accepted with amendment, no confirmation required', 'Accepted with changes which require no confirmation.');
diff --git a/Open-ILS/src/sql/Pg/upgrade/XXXX.data.acq_cancel_not_accepted.sql b/Open-ILS/src/sql/Pg/upgrade/XXXX.data.acq_cancel_not_accepted.sql
new file mode 100644
index 0000000..e8ed2a8
--- /dev/null
+++ b/Open-ILS/src/sql/Pg/upgrade/XXXX.data.acq_cancel_not_accepted.sql
@@ -0,0 +1,14 @@
+
+BEGIN;
+
+INSERT INTO acq.cancel_reason (keep_debits, id, org_unit, label, description)
+ VALUES (
+ 'f',
+ 1007,
+ 1,
+ 'Not accepted',
+ 'This line item is not accepted by the seller.'
+ );
+
+COMMIT;
+
commit b82675e26f0ad627a7276865a9fccb2a6d27fd33
Author: Bill Erickson <berick at esilibrary.com>
Date: Mon Dec 3 09:20:29 2012 -0500
EDI: protect against invalid order response
Do not attempt to createI EDI messages for order responses which
reference nonexistent purchase orders, since it results in
transaction commit errors on invalid foreign keys, preventing
subsequent EDI files from getting processed. Instead, log it
and skip it.
Signed-off-by: Bill Erickson <berick at esilibrary.com>
Signed-off-by: Lebbeous Fogle-Weekley <lebbeous at esilibrary.com>
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 f41d29c..1ed4697 100644
--- a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm
@@ -184,6 +184,10 @@ sub process_retrieval {
if ($msg_hash->{purchase_order}) {
$logger->info("EDI: processing message for PO " . $msg_hash->{purchase_order});
$incoming->purchase_order($msg_hash->{purchase_order});
+ unless ($e->retrieve_acq_purchase_order($incoming->purchase_order)) {
+ $logger->warn("EDI: received order response for nonexistent PO. Skipping...");
+ next;
+ }
}
$e->xact_begin;
commit 721781979545d0a9fdb335de706d58b07cbf0ba2
Author: Bill Erickson <berick at esilibrary.com>
Date: Mon Nov 12 09:35:53 2012 -0500
EDIReader : detect SAN vs. account number in buyer/seller
NAD+BY+XXXXXXX::31B' -- SAN
NAD+BY+YYYYYYY::91' -- Account number
For invoices, try the SAN first followed by the account number to
determine the receiving org unit.
Signed-off-by: Bill Erickson <berick at esilibrary.com>
Signed-off-by: Lebbeous Fogle-Weekley <lebbeous at esilibrary.com>
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 1fd0639..f41d29c 100644
--- a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm
@@ -585,31 +585,46 @@ sub create_acq_invoice_from_edi {
# distinguish provider and shipper?
$eg_inv->recv_method("EDI");
- my $buyer_san = $invoice->{buyer_san};
- if (not $buyer_san) {
- $logger->error($log_prefix . "could not find buyer SAN in INVOIC");
- return 0;
- }
+ # some vendors encode the account number as the SAN.
+ # starting with the san value, then the account value,
+ # treat each as a san, then an acct number until the first success
+ for my $buyer ( ($invoice->{buyer_san}, $invoice->{buyer_acct}) ) {
+ next unless $buyer;
- # some vendors encode the SAN as "$SAN $vendcode"
- $buyer_san =~ s/\s.*//g;
+ # some vendors encode the SAN as "$SAN $vendcode"
+ $buyer =~ s/\s.*//g;
- # Find the matching org unit based on SAN via 'aoa' table.
- my $addrs =
- $e->search_actor_org_address({valid => "t", san => $buyer_san});
+ my $addr = $e->search_actor_org_address(
+ {valid => "t", san => $buyer})->[0];
- if (not $addrs or not @$addrs) {
- $logger->error(
- $log_prefix . "couldn't find OU unit matching buyer SAN in INVOIC:".
- $e->event
+ if ($addr) {
+
+ $eg_inv->receiver($addr->org_unit);
+ last;
+
+ } else {
+
+ my $acct = $e->search_acq_edi_account({vendacct => $buyer})->[0];
+
+ if ($acct) {
+ $eg_inv->receiver($acct->owner);
+ last;
+ }
+ }
+ }
+
+ if (!$eg_inv->receiver) {
+ $logger->error($log_prefix .
+ sprintf("unable to determine buyer (org unit) in invoice; ".
+ "buyer_san=%s; buyer_acct=%s",
+ ($invoice->{buyer_san} || ''),
+ ($invoice->{buyer_acct} || '')
+ )
);
return 0;
}
- # XXX Should we verify that this matches PO ordering agency later?
- $eg_inv->receiver($addrs->[0]->org_unit);
-
$eg_inv->inv_ident($invoice->{invoice_ident});
if (!$eg_inv->inv_ident) {
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm
index 18d46ff..d3b5697 100644
--- a/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm
@@ -20,8 +20,10 @@ my $NEW_LIN_RE = '^LIN'; # starts a new line item
my %edi_fields = (
message_type => qr/^UNH\+\d+\+(\S{6})/,
- buyer_san => qr/^NAD\+BY\+([^:]+)/,
- vendor_san => qr/^NAD\+SU\+([^:]+)/,
+ buyer_san => qr/^NAD\+BY\+([^:]+)::31B/,
+ buyer_acct => qr/^NAD\+BY\+([^:]+)::91/,
+ vendor_san => qr/^NAD\+SU\+([^:]+)::31B/,
+ vendor_acct => qr/^NAD\+SU\+([^:]+)::91/,
purchase_order => qr/^RFF\+ON:(\S+)/,
invoice_ident => qr/^BGM\+380\+([^\+]+)/,
total_billed => qr/^MOA\+86:(\d+)/
commit e52692104abeaf6da197c2b010f64f2e4b3ccadf
Author: Bill Erickson <berick at esilibrary.com>
Date: Fri Sep 28 10:34:28 2012 -0400
Custom/local EDI reader module for ORDRSP and INVOIC (etc)
Provides a new perl module (OpenILS::Utils::EDIReader) for reading
inbound EDI messages and producing data structures more easily
understood by the ACQ code. Through this, extraction of EDI data is
focused in one module instead of spread through various layers.
EDIReader is a small, purpose built module focusing solely on extracting
the needed EDI data and is not meant to be a general purpose EDI library.
* Updates edi_fetcher and the ORDRSP and INVOIC handling code to use the
new libs.
* Removes Business::EDI Evergreen dependency, since it's no longer used (and
is quite large).
Signed-off-by: Bill Erickson <berick at esilibrary.com>
Signed-off-by: Lebbeous Fogle-Weekley <lebbeous at esilibrary.com>
diff --git a/Open-ILS/src/extras/Makefile.install b/Open-ILS/src/extras/Makefile.install
index b3a0953..60c8d66 100644
--- a/Open-ILS/src/extras/Makefile.install
+++ b/Open-ILS/src/extras/Makefile.install
@@ -215,7 +215,6 @@ DEB_APACHE_DISMODS = \
# Chronically unpackaged CPAN modules
CPAN_MODULES = \
- Business::EDI \
Business::OnlinePayment::PayPal \
Library::CallNumber::LC \
Net::Z3950::Simple2ZOOM \
diff --git a/Open-ILS/src/perlmods/Build.PL b/Open-ILS/src/perlmods/Build.PL
index 00b0a26..e2bb24e 100644
--- a/Open-ILS/src/perlmods/Build.PL
+++ b/Open-ILS/src/perlmods/Build.PL
@@ -16,7 +16,6 @@ my $build = Module::Build->new(
'APR::Const' => '0',
'APR::Table' => '0',
'Business::CreditCard' => '0',
- 'Business::EDI' => '0',
'Business::ISBN' => '0',
'Business::OnlinePayment' => '0',
'Carp' => '0',
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 6e9ce69..1fd0639 100644
--- a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm
@@ -16,8 +16,7 @@ use OpenILS::Utils::CStoreEditor q/new_editor/;
use OpenILS::Utils::Fieldmapper;
use OpenILS::Application::Acq::EDI::Translator;
-use OpenILS::Utils::LooseEDI;
-use Business::EDI;
+use OpenILS::Utils::EDIReader;
use Data::Dumper;
our $verbose = 0;
@@ -146,54 +145,75 @@ sub retrieve_core {
$logger->error("(S)FTP get($description) failed");
next;
}
- my $incoming = __PACKAGE__->process_retrieval($content, $remote_file, $server, $account->id, $e);
+ my $incoming = __PACKAGE__->process_retrieval($content, $remote_file, $server, $account->id);
# $server->delete(remote_file => $_); # delete remote copies of saved message
- push @return, $incoming->id;
+ push @return, @$incoming;
}
}
return \@return;
}
-# my $in = OpenILS::Application::Acq::EDI->process_retrieval($file_content, $remote_filename, $server, $account_id, $editor);
+# my $msg_ids = 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) = @_;
$content or return;
- $e ||= new_editor;
- my $account = __PACKAGE__->record_activity( $account_or_id, $e );
+ my $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);
+ my @return;
+
+ 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)); # jedi-2.0
+ $incoming->status('translated');
+ $incoming->translate_time('NOW');
+
+ 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;
+ }
+ # refresh to pickup create_date, etc.
+ $incoming = $e->retrieve_acq_edi_message($incoming->id);
+ $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;
+
+ push(@return, $incoming->id);
}
- return $outgoing;
+
+ return \@return;
}
# ->send_core
@@ -265,6 +285,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 +294,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 {
@@ -396,213 +419,147 @@ sub nice_string {
# return substr($string,0,$head) . "... " . substr($string, -1*$tail);
}
-sub jedi2perl {
- my ($class, $jedi) = @_;
- $jedi or return;
- my $msg = OpenSRF::Utils::JSON->JSON2perl( $jedi );
- open (FOO, ">>/tmp/JSON2perl_dump.txt");
- print FOO Dumper($msg), "\n\n";
- close FOO;
- $logger->warn("Dumped JSON2perl to /tmp/JSON2perl_dump.txt");
- return $msg;
-}
+# 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) = @_;
-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;
- return;
+ if ($incoming->message_type eq 'INVOIC') {
+ return $class->create_acq_invoice_from_edi(
+ $msg_hash, $account->provider, $incoming);
}
-# 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.");
+ # ORDRSP
+ 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;
}
@@ -611,11 +568,13 @@ sub process_jedi {
# process_jedi().
# Return boolean success indicator.
sub create_acq_invoice_from_edi {
- my ($class, $e, $invoice, $provider, $message) = @_;
- # $invoice is O::U::LooseEDI::Message, representing the EDI invoice message.
+ my ($class, $invoice, $provider, $message) = @_;
+ # $invoice is O::U::EDIReader hash
# $provider is only a pkey
# $message is Fieldmapper::acq::edi_message
+ my $e = new_editor();
+
my $log_prefix = "create_acq_invoice_from_edi(..., <acq.edi_message #" .
$message->id . ">): ";
@@ -626,20 +585,16 @@ sub create_acq_invoice_from_edi {
# distinguish provider and shipper?
$eg_inv->recv_method("EDI");
- # Find the buyer's identifier in the invoice.
- my $buyer_san;
- foreach (@{$invoice->{SG2}}) {
- my $nad = $_->{NAD}[0];
- if ($nad->{3035} eq 'BY' and $nad->{C082}{3055} eq '91') {
- $buyer_san = $nad->{C082}{3039};
- }
- }
+ my $buyer_san = $invoice->{buyer_san};
if (not $buyer_san) {
$logger->error($log_prefix . "could not find buyer SAN in INVOIC");
return 0;
}
+ # some vendors encode the SAN as "$SAN $vendcode"
+ $buyer_san =~ s/\s.*//g;
+
# Find the matching org unit based on SAN via 'aoa' table.
my $addrs =
$e->search_actor_org_address({valid => "t", san => $buyer_san});
@@ -655,130 +610,61 @@ sub create_acq_invoice_from_edi {
# XXX Should we verify that this matches PO ordering agency later?
$eg_inv->receiver($addrs->[0]->org_unit);
- try {
- $eg_inv->inv_ident($invoice->{BGM}[0]{1004});
- } catch Error with {
+ $eg_inv->inv_ident($invoice->{invoice_ident});
+
+ if (!$eg_inv->inv_ident) {
$logger->error(
$log_prefix . "no invoice ID # in INVOIC message; " . shift
);
- };
- return 0 unless $eg_inv->inv_ident;
+ return 0;
+ }
my @eg_inv_entries;
- # The invoice message will have once instance of segment group 25
- # per lineitem.
- foreach my $sg25 (@{ $invoice->{SG25} }) {
- # quantity
- my $c186 = $sg25->{QTY}[0]{C186};
- my $quantity = $c186->{6060};
- # $c186->{6411} will probably say 'PCE', but need we check it?
-
- # identifiers (typically ISBN for us, and we may not need these)
- my @identifiers = ();
- # from LIN...
- try {
- my $c212 = $sg25->{LIN}[0]{C212};
- push @identifiers, [$c212->{7143}, $c212->{7140}] if
- $c212 and ref $c212 eq 'HASH';
- } catch Error with {
- # move on
- };
-
- # from PIA...
- try {
- foreach my $pia (@{ $sg25->{PIA} }) {
- foreach my $h (@{$pia->{C212}}) {
- push @identifiers, [$h->{7143}, $h->{7140}];
- }
- }
- } catch Error with {
- # move on
- };
-
- # @identifiers now contains lists of, say,
- # ['IB', '0786222735'], # ISBN 10
- # ['EN','9780786222735'] # ISBN 13
-
- # Segment Group 26-47 are all descendants of SG25.
+ $message->purchase_order($invoice->{purchase_order});
- # Segment Group 26 concerns *lineitem* price (i.e, total for all copies
- # on this lineitem).
+ for my $lineitem (@{$invoice->{lineitems}}) {
+ my $li_id = $lineitem->{id};
- my $lineitem_price = $sg25->{SG26}[0]{MOA}[0]{C516}{5004};
+ if (!$li_id) {
+ $logger->warn($log_prefix . "no lineitem ID");
+ next;
+ }
- # Segment Group 28 concerns *unit* (lineitem detail) price. We may
- # not actually use this. TBD.
- my $per_unit_price;
- foreach my $sg28 (@{$sg25->{SG28}}) {
- my $c509 = $sg28->{PRI}[0]{C509};
- my ($price_qualifier, $price_qualifier_type);
- ($per_unit_price, $price_qualifier, $price_qualifier_type) = (
- $c509->{5118}, $c509->{5125}, $c509->{5387}
- );
+ my $li = $e->retrieve_acq_lineitem($li_id);
- # price_qualifier=AAA seems to be the price to use. Otherwise,
- # take what we can get.
- last if $price_qualifier eq 'AAA';
+ if (!$li) {
+ $logger->warn($log_prefix .
+ "no LI found with ID: $li_id : " . $e->event);
+ return 0;
}
- # Segment Group 29 will have references to LI and PO numbers
- my $acq_identifiers = {};
- foreach my $sg29 (@{$sg25->{SG29}}) {
- foreach my $rff (@{$sg29->{RFF}}) {
- my $c506 = $rff->{C506};
- if ($c506->{1153} eq 'ON') {
- $acq_identifiers->{po} = $c506->{1154};
- } elsif ($c506->{1153} eq 'LI') {
- my ($po, $li) = split m./., $c506->{1154};
- if ($po and $li) {
- if ($acq_identifiers->{po}) {
- $logger->warn(
- $log_prefix .
- "RFFs within lineitem disagree on PO # ?"
- ) unless $acq_identifiers->{po} eq $po;
- }
- $acq_identifiers->{li} = $li;
- $acq_identifiers->{po} = $po;
- } else {
- $logger->warn(
- $log_prefix .
- "RFF 1154 doesn't match expectations (.+/.+) " .
- "where 1153 is 'LI'"
- );
- }
- }
- }
+ my ($quant) = grep {$_->{code} eq '47'} @{$lineitem->{quantities}};
+ my $quantity = ($quant) ? $quant->{quantity} : 0;
+
+ if (!$quantity) {
+ $logger->warn($log_prefix .
+ "no invoice quantity specified for LI $li_id");
+ next;
}
- if ($acq_identifiers->{po}) {
- # First PO number seen in INVOIC sets the purchase_order field for
- # the entry in acq.edi_message (which model may need a rethink).
+ # NOTE: if needed, we also have $lineitem->{net_unit_price}
+ # and $lineitem->{gross_unit_price}
+ my $lineitem_price = $lineitem->{amount_billed};
- $message->purchase_order($acq_identifiers->{po}) unless
- $message->purchase_order;
- } else {
- $logger->warn(
- $log_prefix .
- "SG29 missing or refers to no purchase order that we can tell"
- );
- }
- if (not $acq_identifiers->{li}) {
- $logger->warn(
- $log_prefix .
- "SG29 missing or refers to no lineitem that we can tell"
- );
- }
+ # if the top-level PO value is unset, get it from the first LI
+ $message->purchase_order($li->purchase_order)
+ unless $message->purchase_order;
my $eg_inv_entry = Fieldmapper::acq::invoice_entry->new;
$eg_inv_entry->inv_item_count($quantity);
# XXX Validate by making sure the LI is on-order and belongs to
# the right provider and ordering agency and all that.
- $eg_inv_entry->lineitem($acq_identifiers->{li});
+ $eg_inv_entry->lineitem($li_id);
# XXX Do we actually need to link to PO directly here?
- $eg_inv_entry->purchase_order($acq_identifiers->{po});
+ $eg_inv_entry->purchase_order($li->purchase_order);
# This is the total price for all units billed, not per-unit.
$eg_inv_entry->cost_billed($lineitem_price);
@@ -788,26 +674,41 @@ sub create_acq_invoice_from_edi {
my @eg_inv_items;
- # Find any taxes applied to the whole invoice.
- try {
- if ($invoice->{SG50}) {
- foreach my $sg50 (@{ $invoice->{SG50} }) {
- if ($sg50->{TAX} and $sg50->{MOA}) {
- my $tax_amount = $sg50->{MOA}[0]{C516}{5004};
+ my %charge_type_map = (
+ 'TX' => ['TAX', 'Tax from electronic invoice'],
+ 'CA' => ['PRO', 'Cataloging services'],
+ 'DL' => ['SHP', 'Delivery']
+ );
- my $eg_inv_item = Fieldmapper::acq::invoice_item->new;
- $eg_inv_item->inv_item_type('TAX');
- $eg_inv_item->cost_billed($tax_amount);
- # XXX i18n somehow? or maybe omit the note.
- $eg_inv_item->note('Tax from electronic invoice');
+ for my $charge (@{$invoice->{misc_charges}}) {
+ my $eg_inv_item = Fieldmapper::acq::invoice_item->new;
- push @eg_inv_items, $eg_inv_item;
- }
- }
+ my $amount = $charge->{charge_amount};
+
+ if (!$amount) {
+ $logger->warn($log_prefix . "charge with no amount");
+ next;
+ }
+
+ my $map = $charge_type_map{$charge->{charge_type}};
+
+ if (!$map) {
+ $map = [
+ 'PRO',
+ 'Unknown charge type ' . $charge->{charge_type}
+ ];
}
- } catch Error with {
- # move on
- };
+
+ $eg_inv_item->inv_item_type($$map[0]);
+ $eg_inv_item->note($$map[1]);
+ $eg_inv_item->cost_billed($amount);
+
+ push @eg_inv_items, $eg_inv_item;
+ }
+
+ $logger->info($log_prefix .
+ sprintf("creating invoice with %d entries and %d items.",
+ scalar(@eg_inv_entries), scalar(@eg_inv_items)));
$e->xact_begin;
@@ -854,252 +755,5 @@ sub create_acq_invoice_from_edi {
return 1;
}
-# returns message object if processing should continue
-# returns false/undef value if processing should abort
-
-sub message_object {
- my $class = shift;
- my $body = shift or return;
- my $key = shift if @_;
- my $keystring = $key || 'UNSPECIFIED';
-
- my $msg = Business::EDI::Message->new($body);
- unless ($msg) {
- $logger->error("EDI interchange message: $keystring body failed Business::EDI constructor. Skipping it.");
- return;
- }
- $key = $msg->code if ! $key; # Now we set the key for reference if it wasn't specified
- my $val_0065 = $msg->xpath_value('UNH/S009/0065') || '';
- unless ($val_0065 eq $key) {
- $logger->error("EDI $key UNH/S009/0065 ('$val_0065') conflicts w/ message type $key. Aborting");
- return;
- }
- my $val_0051 = $msg->xpath_value('UNH/S009/0051') || '';
- unless ($val_0051 eq 'UN') {
- $logger->warn("EDI $key UNH/S009/0051 designates '$val_0051', not 'UN' as controlling agency. Attempting to process anyway");
- }
- my $val_0054 = $msg->xpath_value('UNH/S009/0054') || '';
- if ($val_0054) {
- $logger->info("EDI $key UNH/S009/0054 uses Spec revision version '$val_0054'");
- # Possible Spec Version limitation
- # my $yy = $tag_0054 ? substr($val_0054,0,2) : '';
- # unless ($yy eq '00' or $yy > 94 ...) {
- # $logger->warn("EDI $key UNH/S009/0051 Spec revision version '$val_0054' not supported");
- # }
- } else {
- $logger->warn("EDI $key UNH/S009/0054 does not reference a known Spec revision version");
- }
- return $msg;
-}
-
-=head2 ->eg_li($lineitem_object, [$remote, $server_log_string, $editor])
-
-my $line_item = OpenILS::Application::Acq::EDI->eg_li($edi_line, $remote, "test_server_01", $e);
-
- $remote is a acq.edi_account Fieldmapper object.
- $server_log_string is an arbitrary string use to identify the remote host in potential log messages.
-
-Updates:
- acq.lineitem.estimated_unit_price,
- acq.lineitem.state (dependent on mapping codes),
- acq.lineitem.expected_recv_time,
- acq.lineitem.edit_time (consequently)
-
-=cut
-
-sub eg_li {
- my ($class, $line, $server, $server_log_string, $e) = @_;
- $line or return;
- $e ||= new_editor();
-
- my $id;
- # my $rff = $line->part('line_reference/RFF') or $logger->warn("EDI ORDRSP line_detail/RFF missing!");
- my $val_1153 = $line->xpath_value('line_reference/RFF/1153') || '';
- my $val_1154 = $line->xpath_value('line_reference/RFF/1154') || '';
- my $val_1082 = $line->xpath_value('LIN/1082') || '';
-
- my @po_nums;
-
- $val_1154 =~ s#^(.*)\/##; # Many sources send the ID as 'order_ID/LI_ID'
- $1 and push @po_nums, $1;
- $val_1082 =~ s#^(.*)\/##; # Many sources send the ID as 'order_ID/LI_ID'
- $1 and push @po_nums, $1;
-
- # TODO: possible check of po_nums
- # now do a lot of checking
-
- if ($val_1153 eq 'LI') {
- $id = $val_1154 or $logger->warn("EDI ORDRSP RFF/1154 reference to LI empty. Attempting failover to LIN/1082");
- } else {
- $logger->warn("EDI ORDRSP RFF/1153 unexpected value ('$val_1153', not 'LI'). Attempting failover to LIN/1082");
- }
-
- # FIXME - the line item ID in LIN/1082 ought to match RFF/1154, but
- # not all materials vendors obey this. Commenting out check for now
- # as being too strict.
- #if ($id and $val_1082 and $val_1082 ne $id) {
- # $logger->warn("EDI ORDRSP LIN/1082 Line Item ID mismatch ($id vs. $val_1082): cannot target update");
- # return;
- #}
-
- $id ||= $val_1082 || '';
- if ($id eq '') {
- $logger->warn('Cannot identify line item from EDI message');
- return;
- }
-
- $logger->info("EDI retrieve/update lineitem $id");
-
- my $li = OpenILS::Application::Acq::Lineitem::retrieve_lineitem_impl($e, $id, {
- flesh_li_details => 1,
- }, 1); # Could send more {options}. The 1 is for no_auth.
-
- if (! $li or ref($li) ne 'Fieldmapper::acq::lineitem') {
- $logger->error("EDI failed to retrieve lineitem by id '$id' for server $server_log_string");
- return;
- }
- unless ((! $server) or (! $server->provider)) { # but here we want $server to be acq.edi_account instead of RemoteAccount
- if ($server->provider != $li->provider) {
- # links go both ways: acq.provider.edi_default and acq.edi_account.provider
- $logger->info("EDI acct provider (" . $server->provider. ") doesn't match lineitem provider("
- . $li->provider . "). Checking acq.provider.edi_default...");
- my $provider = $e->retrieve_acq_provider($li->provider);
- if ($provider->edi_default != $server->id) {
- $logger->error(sprintf "EDI provider/acct %s/%s (%s) is blocked from updating lineitem $id belonging to provider/edi_default %s/%s",
- $server->provider, $server->id, $server->label, $li->provider, $provider->edi_default);
- return;
- }
- }
- }
-
- my @lin_1229 = $line->xpath('LIN/1229') or $logger->warn("EDI LIN/1229 Action Code missing!");
- my $key = $lin_1229[0] or return;
-
- my $eg_reason = $e->retrieve_acq_cancel_reason(1000 + $key->value); # DB populated w/ spec keys in 1000's
- $eg_reason or $logger->warn(sprintf "EDI LIN/1229 Action Code '%s' (%s) not recognized in acq.cancel_reason", $key->value, $key->label);
- $eg_reason or return;
-
- $li->cancel_reason($eg_reason->id);
- unless ($eg_reason->keep_debits) {
- $logger->warn("EDI LIN/1229 Action Code '%s' (%s) has keep_debits=0", $key->value, $key->label);
- }
-
- my @prices = $line->xpath_value("line_price/PRI/5118");
- $li->estimated_unit_price($prices[0]) if @prices;
-
- return $li;
-}
-
-# caching not needed for now (edi_fetcher is asynchronous)
-# sub get_reason {
-# my ($class, $key, $e) = @_;
-# $reasons->{$key} and return $reasons->{$key};
-# $e ||= new_editor();
-# $reasons->{$key} = $e->retrieve_acq_cancel_reason($key);
-# return $reasons->{$key};
-# }
-
1;
-__END__
-
-Example JSON data.
-
-Note the pseudo-hash 2-element arrays.
-
-[
- 'SG26',
- [
- [
- 'LIN',
- {
- '1229' => '5',
- '1082' => 1,
- 'C212' => {
- '7140' => '9780446360272',
- '7143' => 'EN'
- }
- }
- ],
- [
- 'IMD',
- {
- '7081' => 'BST',
- '7077' => 'F',
- 'C273' => {
- '7008' => [
- 'NOT APPLIC WEBSTERS NEW WORLD THESA'
- ]
- }
- }
- ],
- [
- 'QTY',
- {
- 'C186' => {
- '6063' => '21',
- '6060' => 10
- }
- }
- ],
- [
- 'QTY',
- {
- 'C186' => {
- '6063' => '12',
- '6060' => 10
- }
- }
- ],
- [
- 'QTY',
- {
- 'C186' => {
- '6063' => '85',
- '6060' => 0
- }
- }
- ],
- [
- 'FTX',
- {
- '4451' => 'LIN',
- 'C107' => {
- '4441' => '01',
- '3055' => '28',
- '1131' => '8B'
- }
- }
- ],
- [
- 'SG30',
- [
- [
- 'PRI',
- {
- 'C509' => {
- '5118' => '4.5',
- '5387' => 'SRP',
- '5125' => 'AAB'
- }
- }
- ]
- ]
- ],
- [
- 'SG31',
- [
- [
- 'RFF',
- {
- 'C506' => {
- '1154' => '8/1',
- '1153' => 'LI'
- }
- }
- ]
- ]
- ]
- ]
-],
-
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm
new file mode 100644
index 0000000..18d46ff
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm
@@ -0,0 +1,158 @@
+# ---------------------------------------------------------------
+# Copyright (C) 2012 Equinox Software, Inc
+# Author: Bill Erickson <berickr at esilibrary.com>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+# ---------------------------------------------------------------
+package OpenILS::Utils::EDIReader;
+use strict; use warnings;
+
+my $NEW_MSG_RE = '^UNH'; # starts a new message
+my $NEW_LIN_RE = '^LIN'; # starts a new line item
+
+my %edi_fields = (
+ message_type => qr/^UNH\+\d+\+(\S{6})/,
+ buyer_san => qr/^NAD\+BY\+([^:]+)/,
+ vendor_san => qr/^NAD\+SU\+([^:]+)/,
+ purchase_order => qr/^RFF\+ON:(\S+)/,
+ invoice_ident => qr/^BGM\+380\+([^\+]+)/,
+ total_billed => qr/^MOA\+86:(\d+)/
+);
+
+my %edi_li_fields = (
+ id => qr/^RFF\+LI:\S+\/(\S+)/,
+ index => qr/^LIN\+([^\+]+)/,
+ amount_billed => qr/^MOA\+203:(\d+)/,
+ net_unit_price => qr/^PRI\+AAA:(\d+)/,
+ gross_unit_price=> qr/^PRI\+AAB:(\d+)/,
+ expected_date => qr/^DTM\+44:([^:]+)/
+);
+
+my %edi_li_ident_fields = (
+ ident => qr/^LIN\+\S+\++([^:]+):?(\S+)?/,
+ ident2 => qr/^PIA\+0*5\+([^:]+):?(\S+)?/,
+);
+
+my %edi_li_quant_fields = (
+ code => qr/^QTY\+(\d+):/,
+ quantity => qr/^QTY\+\d+:(\d+)/
+);
+
+my %edi_charge_fields = (
+ charge_type => qr/^ALC\+C\++([^\+]+)/,
+ charge_amount => qr/^MOA\+(8|131):(\d+)/
+);
+
+sub new {
+ return bless({}, shift());
+}
+
+# see read()
+sub read_file {
+ my $self = shift;
+ my $file = shift;
+
+ open(EDI_FILE, $file) or die "Cannot open $file: $!\n";
+ my $edi = join('', <EDI_FILE>);
+ close EDI_FILE;
+
+ return $self->read($edi);
+}
+
+# Reads an EDI string and parses the package one "line" at a time, extracting
+# needed information via regular expressions. Returns an array of messages,
+# each represented as a hash. See %edi_*fields above for lists of which fields
+# may be present within a message.
+
+sub read {
+ my $self = shift;
+ my $edi = shift or return [];
+ my @msgs;
+
+ $edi =~ s/\n//og;
+
+ foreach (split(/'/, $edi)) {
+ my $msg = $msgs[-1];
+
+ # - starting a new message
+
+ if (/$NEW_MSG_RE/) {
+ $msg = {lineitems => [], misc_charges => []};
+ push(@msgs, $msg);
+ }
+
+ # extract top-level message fields
+
+ next unless $msg;
+
+ for my $field (keys %edi_fields) {
+ ($msg->{$field}) = $_ =~ /$edi_fields{$field}/
+ if /$edi_fields{$field}/;
+ }
+
+ # - starting a new lineitem
+
+ if (/$NEW_LIN_RE/) {
+ $msg->{_current_li} = {};
+ push(@{$msg->{lineitems}}, $msg->{_current_li});
+ }
+
+ # - extract lineitem fields
+
+ if (my $li = $msg->{_current_li}) {
+
+ for my $field (keys %edi_li_fields) {
+ ($li->{$field}) = $_ =~ /$edi_li_fields{$field}/g
+ if /$edi_li_fields{$field}/;
+ }
+
+ for my $field (keys %edi_li_ident_fields) {
+ if (/$edi_li_ident_fields{$field}/) {
+ my ($ident, $type) = $_ =~ /$edi_li_ident_fields{$field}/;
+ push(@{$li->{identifiers}}, {code => $type, value => $ident});
+ }
+ }
+
+ if (/$edi_li_quant_fields{quantity}/) {
+ my $quant = {};
+ ($quant->{quantity}) = $_ =~ /$edi_li_quant_fields{quantity}/;
+ ($quant->{code}) = $_ =~ /$edi_li_quant_fields{code}/;
+ push(@{$li->{quantities}}, $quant);
+ }
+
+ }
+
+ # - starting a new misc. charge
+
+ if (/$edi_charge_fields{charge_type}/) {
+ $msg->{_current_charge} = {};
+ push (@{$msg->{misc_charges}}, $msg->{_current_charge});
+ }
+
+ # - extract charge fields
+
+ if (my $charge = $msg->{_current_charge}) {
+ for my $field (keys %edi_charge_fields) {
+ ($charge->{$field}) = $_ =~ /$edi_charge_fields{$field}/
+ if /$edi_charge_fields{$field}/;
+ }
+ }
+ }
+
+ # remove the state-maintenance keys
+ for my $msg (@msgs) {
+ foreach (grep /^_/, keys %$msg) {
+ delete $msg->{$_};
+ }
+ }
+
+ return \@msgs;
+}
diff --git a/Open-ILS/src/perlmods/t/14-OpenILS-Utils.t b/Open-ILS/src/perlmods/t/14-OpenILS-Utils.t
index 9878956..209a48b 100644
--- a/Open-ILS/src/perlmods/t/14-OpenILS-Utils.t
+++ b/Open-ILS/src/perlmods/t/14-OpenILS-Utils.t
@@ -1,6 +1,6 @@
#!perl -T
-use Test::More tests => 24;
+use Test::More tests => 29;
use_ok( 'OpenILS::Utils::Configure' );
use_ok( 'OpenILS::Utils::Cronscript' );
@@ -20,6 +20,7 @@ use_ok( 'OpenILS::Utils::RemoteAccount' );
use_ok( 'OpenILS::Utils::ScriptRunner' );
use_ok( 'OpenILS::Utils::SpiderMonkey' );
use_ok( 'OpenILS::Utils::ZClient' );
+use_ok( 'OpenILS::Utils::EDIReader' );
# LP 800269 - Test MFHD holdings for records that only contain a caption field
my $co_marc = MARC::Record->new();
@@ -80,3 +81,13 @@ my $clean_xml = OpenILS::Utils::Normalize::clean_marc($raw_marcxml);
is($clean_xml, $exp_xml, "clean_marc: header and space normalization");
is(OpenILS::Utils::Normalize::clean_marc('èöçÇÈÀ'), 'èöçÇÈÀ', 'clean_marc: diacritics');
+
+my $edi_invoice = "UNA:+.? 'UNB+UNOC:3+1556150:31B+123EVER:31B+120926:1621+4'UNH+11+INVOIC:D:96A:UN'BGM+380+5TST084026+9'DTM+137:20120924:102'RFF+ON:24'NAD+BY+123EVER 0001::91'NAD+SU+1691503::31B'CUX+2:USD:4'LIN+1++9780446360272'QTY+47:5'MOA+146:4.5:USD:10'MOA+203:14.65'PRI+AAF:2.93:DI:NTP'RFF+LI:24/102'LIN+2++9780446357197'QTY+47:8'MOA+146:6.5:USD:10'MOA+203:33.84'PRI+AAF:4.23:DI:NTP'RFF+LI:24/100'UNS+S'MOA+86:66.18'ALC+C++++DL'MOA+8:2'ALC+C++++CA'MOA+131:12.3'ALC+C++++TX'MOA+8:3.39'UNT+28+11'UNH+12+INVOIC:D:96A:UN'BGM+380+5TST084027+9'DTM+137:20120924:102'RFF+ON:26'NAD+BY+123EVER 0001::91'NAD+SU+1691503::31B'CUX+2:USD:4'LIN+1++9780446360272'QTY+47:1'MOA+146:4.5:USD:10'MOA+203:4.05'PRI+AAF:4.05:DI:NTP'RFF+LI:26/106'LIN+2++9780446350105'QTY+47:3'MOA+146:6.99:USD:10'MOA+203:14.67'PRI+AAF:4.89:DI:NTP'RFF+LI:26/105'UNS+S'MOA+86:25.03'ALC+C++++DL'MOA+8:2'ALC+C++++CA'MOA+131:3'ALC+C++++TX'MOA+8:1.31'UNT+28+12'UNZ+4+4'";
+
+my $edi_msgs = OpenILS::Utils::EDIReader->new->read($edi_invoice);
+
+is($edi_msgs->[0]->{message_type}, 'INVOIC', 'edi reader: message type');
+is($edi_msgs->[0]->{purchase_order}, '24', 'edi reader: PO number');
+is($edi_msgs->[1]->{invoice_ident}, '5TST084027', 'edi reader: invoice ident');
+is(scalar(@{$edi_msgs->[1]->{lineitems}}), '2', 'edi reader: lineitem count');
+
diff --git a/Open-ILS/src/support-scripts/edi_fetcher.pl b/Open-ILS/src/support-scripts/edi_fetcher.pl
index 9d5f168..e4feb0f 100755
--- a/Open-ILS/src/support-scripts/edi_fetcher.pl
+++ b/Open-ILS/src/support-scripts/edi_fetcher.pl
@@ -122,8 +122,7 @@ if (@ARGV) {
$content,
"localhost:" . File::Spec->rel2abs($_),
OpenILS::Application::Acq::EDI->remote_account($acct),
- $acct,
- $e
+ $acct
);
}
exit;
diff --git a/Open-ILS/src/support-scripts/test-scripts/edi_reader.pl b/Open-ILS/src/support-scripts/test-scripts/edi_reader.pl
new file mode 100755
index 0000000..242f905
--- /dev/null
+++ b/Open-ILS/src/support-scripts/test-scripts/edi_reader.pl
@@ -0,0 +1,9 @@
+#!/usr/bin/perl
+use strict; use warnings;
+use OpenILS::Utils::EDIReader;
+use Data::Dumper;
+
+my $reader = OpenILS::Utils::EDIReader->new;
+my $msgs = $reader->read_file(shift());
+print Dumper($msgs);
+
-----------------------------------------------------------------------
Summary of changes:
Open-ILS/src/extras/Makefile.install | 1 -
Open-ILS/src/perlmods/Build.PL | 1 -
.../perlmods/lib/OpenILS/Application/Acq/EDI.pm | 1069 +++++++++-----------
.../src/perlmods/lib/OpenILS/Utils/EDIReader.pm | 165 +++
Open-ILS/src/perlmods/t/14-OpenILS-Utils.t | 13 +-
Open-ILS/src/sql/Pg/002.schema.config.sql | 2 +-
Open-ILS/src/sql/Pg/950.data.seed-values.sql | 1 +
.../upgrade/0751.data.acq_cancel_not_accepted.sql | 15 +
Open-ILS/src/support-scripts/edi_fetcher.pl | 3 +-
.../src/support-scripts/test-scripts/edi_reader.pl | 9 +
docs/RELEASE_NOTES_NEXT/edireader.txt | 28 +
11 files changed, 700 insertions(+), 607 deletions(-)
create mode 100644 Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm
create mode 100644 Open-ILS/src/sql/Pg/upgrade/0751.data.acq_cancel_not_accepted.sql
create mode 100755 Open-ILS/src/support-scripts/test-scripts/edi_reader.pl
create mode 100644 docs/RELEASE_NOTES_NEXT/edireader.txt
hooks/post-receive
--
Evergreen ILS
More information about the open-ils-commits
mailing list