From b1c9f9c8b030060aa4df4ebc98c37cc05f5f6207 Mon Sep 17 00:00:00 2001
From: Bill Erickson <berick@esilibrary.com>
Date: Tue, 17 Jul 2012 11:08:35 -0400
Subject: [PATCH] Support Purchase Order name extraction from upload
It's now possible to extract a purchase order name from a MARC order
record file received from a vendor. If the provider has an attribute
definition (Admin -> Server Admin -> Acquisitions -> Providers ->
Attribute Definitions) configured with code "purchase_order" and the
order record contains a PO name at the configured MARC field/subfield,
the PO name will be used for the newly created purchase order.
Example attribute configuration:
code => purchase_order
xpath => //*[@tag="980"]/*[@code="p"]
Is Identifier => false
*note 980p is arbitrary
Signed-off-by: Bill Erickson <berick@esilibrary.com>
Signed-off-by: Mike Rylander <mrylander@gmail.com>
---
.../perlmods/lib/OpenILS/Application/Acq/Order.pm | 43 ++++++++++++++++++++++
1 file changed, 43 insertions(+)
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Order.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Order.pm
index 6e4711e560..aa8a45d77d 100644
--- a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Order.pm
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Order.pm
@@ -1417,6 +1417,11 @@ sub upload_records {
$mgr->respond;
}
+ if ($po) {
+ $evt = extract_po_name($mgr, $po, \@li_list);
+ return $evt if $evt;
+ }
+
$e->commit;
unlink($filename);
$cache->delete_cache('vandelay_import_spool_' . $key);
@@ -1434,6 +1439,44 @@ sub upload_records {
return $mgr->respond_complete;
}
+# see if the PO name is encoded in the newly imported records
+sub extract_po_name {
+ my ($mgr, $po, $li_ids) = @_;
+ my $e = $mgr->editor;
+
+ # find the first instance of the name
+ my $attr = $e->search_acq_lineitem_attr([
+ { lineitem => $li_ids,
+ attr_type => 'lineitem_provider_attr_definition',
+ attr_name => 'purchase_order'
+ }, {
+ order_by => {aqlia => 'id'},
+ limit => 1
+ }
+ ])->[0] or return undef;
+
+ my $name = $attr->attr_value;
+
+ # see if another PO already has the name, provider, and org
+ my $existing = $e->search_acq_purchase_order(
+ { name => $name,
+ ordering_agency => $po->ordering_agency,
+ provider => $po->provider
+ },
+ {idlist => 1}
+ )->[0];
+
+ # if a PO exists with the same name (and provider/org)
+ # tack the po ID into the name to differentiate
+ $name = sprintf("$name (%s)", $po->id) if $existing;
+
+ $logger->info("Extracted PO name: $name");
+
+ $po->name($name);
+ update_purchase_order($mgr, $po) or return $e->die_event;
+ return undef;
+}
+
sub import_lineitem_details {
my($mgr, $ordering_agency, $li) = @_;
--
2.11.0