From 6da5238795b7b5486b62e2c7851f6802eb516362 Mon Sep 17 00:00:00 2001 From: Bill Erickson Date: Wed, 25 May 2016 18:09:22 -0400 Subject: [PATCH] LP#1513872 EDI attrs Perl WIP Signed-off-by: Bill Erickson --- .../src/perlmods/lib/OpenILS/Utils/EDIWriter.pm | 571 +++++++++++++++++++++ .../src/support-scripts/test-scripts/edi_writer.pl | 25 + 2 files changed, 596 insertions(+) create mode 100644 Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIWriter.pm create mode 100755 Open-ILS/src/support-scripts/test-scripts/edi_writer.pl diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIWriter.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIWriter.pm new file mode 100644 index 0000000000..3036f34ab7 --- /dev/null +++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIWriter.pm @@ -0,0 +1,571 @@ +# --------------------------------------------------------------- +# Copyright (C) 2016 King County Library System +# Author: Bill Erickson +# +# Copied heavily from Application/Trigger/Reactor.pm +# +# 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::EDIWriter; +use strict; use warnings; +use OpenILS::Utils::CStoreEditor qw/:funcs/; +use OpenILS::Application::AppUtils; +use DateTime; +my $U = 'OpenILS::Application::AppUtils'; + +sub new { + my ($class, $args) = @_; + $args ||= {}; + return bless($args, $class); +} + +# Returns EDI string on success, undef on error. +sub write { + my ($self, $po_id, $msg_type) = @_; + $msg_type ||= 'order'; + + my $po = $self->get_po($po_id); + return undef unless $po; + + $self->compile_po($po); + return undef unless $self->{compiled}; + + my $edi = $self->build_order_edi if $msg_type eq 'order'; + + # remove the newlines unless we are pretty printing + $edi =~ s/\n//g unless $self->{pretty}; + + return $edi; +} + +sub get_po { + my ($self, $po_id) = @_; + return new_editor()->retrieve_acq_purchase_order([ + $po_id, { + flesh => 5, + flesh_fields => { + acqpo => [qw/lineitems ordering_agency provider/], + acqpro => [qw/edi_default/], + acqedi => [qw/attr_set/], + aeas => [qw/attr_maps/], + jub => [qw/lineitem_details lineitem_notes attributes/], + acqlid => [qw/owning_lib location fund eg_copy_id/], + acp => [qw/location call_number/], + aou => [qw/mailing_address/] + } + } + ]); +} + +sub escape_edi { + my ($self, $value) = @_; + return '' if (not defined $value || ref($value)); + + # Typical vendors dealing with EDIFACT (or is the problem with + # our EDI translator itself?) would seem not to want + # any characters outside the ASCII range, so trash them. + $value =~ s/[^[:ascii:]]//g; + + # What the heck, get rid of [ ] too (although I couldn't get them + # to cause any problems for me, problems have been reported. See + # LP #812593). + $value =~ s/[\[\]]//g; + + # Characters [? + ' \ : ] are all potentially problematic for + # EDI messages, regardless of their position in the string. + # Safest to simply remove them. + $value =~ s/[\\\?\+':]//g; + + # Replace newlines with spaces. + $value =~ s/\n/ /g; + + return $value; +} + +# Returns an EDI-escaped version of the requested lineitem attribute +# value. If $attr_type is not set, the first attribute found matching +# the requested $attr_name will be used. +sub get_li_attr { + my ($self, $li, $attr_name, $attr_type) = @_; + + for my $attr (@{$li->attributes}) { + next unless $attr->attr_name eq $attr_name; + next if $attr_type && $attr->attr_type ne $attr_type; + return $self->escape_edi($attr->attr_value); + } + + return ''; +} + +# Generates a HASH version of the PO with all of the data necessary +# to generate an EDI message from the PO. +sub compile_po { + my ($self, $po) = @_; + + # Cannot generate EDI if the PO has no linked EDI account. + return undef unless $po->provider->edi_default; + + my %compiled = ( + po_id => $po->id, + po_name => $self->escape_edi($po->name), + provider_id => $po->provider->id, + vendor_san => $po->provider->san, + org_unit_san => $po->ordering_agency->mailing_address->san, + currency_type => $po->provider->currency_type, + edi_attrs => {}, + lineitems => [] + ); + + $self->{compiled} = \%compiled; + + if ($po->provider->edi_default->attr_set) { + $compiled{edi_attrs}{$_->attr} = 1 + for @{$po->provider->edi_default->attr_set->attr_maps} + } + + $compiled{buyer_code} = + $compiled{edi_attrs}->{BUYER_ID_INCLUDE_VENDCODE} ? # B&T + $compiled{vendor_san}.' '.$po->provider->edi_default->vendcode : + $po->provider->edi_default->vendacct; + + push(@{$compiled{lineitems}}, + $self->compile_li($_)) for @{$po->lineitems}; + + return \%compiled; +} + +# Translate a lineitem order identifier attribute into an +# EDI ID value and ID qualifier. +sub set_li_order_ident { + my ($self, $li, $li_hash) = @_; + + my $idqual = 'EN'; # ISBN13 + my $idval = ''; + + if ($self->{compiled}->{edi_attr}->{LINEITEM_IDENT_VENDOR_NUMBER}) { + # See if we have a vendor-specific lineitem identifier value + $idval = $self->get_li_attr($li, 'vendor_num'); + } + + if (!$idval) { + + my $attr = $self->get_li_order_ident_attr($li->attributes); + + if ($attr) { + my $name = $attr->attr_name; + $idval = $attr->attr_value; + + if ($name eq 'isbn' && length($idval) != 13) { + $idqual = 'IB'; + } elsif ($name eq 'issn') { + $idqual = 'IS'; + } + } else { + $idqual = 'IN'; + $idval = $li->id; + } + } + + $li_hash->{idqual} = $idqual; + $li_hash->{idval} = $idval; +} + +# Find the acq.lineitem_attr object that represents the identifier +# for a lineitem. +sub get_li_order_ident_attr { + my ($self, $attrs) = @_; + + # preferred identifier + my ($attr) = grep { $U->is_true($_->order_ident) } @$attrs; + return $attr if $attr; + + # note we're not using get_li_attr, since we need the + # attr object and not just the attr value + + # isbn-13 + ($attr) = grep { + $_->attr_name eq 'isbn' and + $_->attr_type eq 'lineitem_marc_attr_definition' and + length($_->attr_value) == 13 + } @$attrs; + return $attr if $attr; + + for my $name (qw/isbn issn upc/) { + ($attr) = grep { + $_->attr_name eq $name and + $_->attr_type eq 'lineitem_marc_attr_definition' + } @$attrs; + return $attr if $attr; + } + + # any 'identifier' attr + return (grep { $_->attr_name eq 'identifier' } @$attrs)[0]; +} + +# Collect FTX notes and chop them into FTX-compatible values. +sub get_li_ftx { + my ($self, $li) = @_; + + # all vendor-public, non-empty lineitem notes + my @notes = + map {$_->value} + grep { $U->is_true($_->vendor_public) && $_->value } + @{$li->lineitem_notes}; + + if ($self->{compiled}->{edi_attr}->{COPY_SPEC_CODES}) { + for my $lid (@{$li->lineitem_details}) { + push(@notes, $lid->note) + if ($lid->note || '') =~ /spec code [a-zA-Z0-9_]/; + } + } + + my @trimmed_notes; + + if (!@notes && $self->{compiled}->{edi_attr}->{INCLUDE_EMPTY_LI_NOTE}) { + # lineitem has no notes. Add a blank note if needed. + push(@trimmed_notes, ''); + + } else { + # EDI FTX fields have a max length of 512 + # While we're in here, EDI-escape the note values + for my $note (@notes) { + $note = $self->escape_edi($note); + my @parts = ($note =~ m/.{1,512}/g); + push(@trimmed_notes, @parts); + } + } + + return \@trimmed_notes; +} + +sub compile_li { + my ($self, $li) = @_; + + my $li_hash = { + id => $li->id, + quantity => scalar(@{$li->lineitem_details}), + estimated_unit_price => $li->estimated_unit_price || '0.00', + notes => $self->get_li_ftx($li), + copies => [] + }; + + $self->set_li_order_ident($li, $li_hash); + + for my $name (qw/title author edition pubdate publisher pagination/) { + $li_hash->{$name} = $self->get_li_attr($li, $name); + } + + $self->compile_copies($li, $li_hash); + + return $li_hash; +} + +sub compile_copies { + my ($self, $li, $li_hash) = @_; + + # does this EDI account want copy data? + return unless $self->{compiled}->{edi_attrs}->{INCLUDE_COPIES}; + + for my $copy (@{$li->lineitem_details}) { + $self->compile_copy($li, $li_hash, $copy); + } +} + +sub compile_copy { + my ($self, $li, $li_hash, $copy) = @_; + + my $fund = $copy->fund ? $copy->fund->code : ''; + my $item_type = $copy->circ_modifier || ''; + my $call_number = $copy->cn_label || ''; + my $owning_lib = $copy->owning_lib ? $copy->owning_lib->shortname : ''; + my $location = $copy->location ? $copy->location->name : ''; + my $collection_code = $copy->collection_code || ''; + + # When an ACQ copy links to a real copy (acp), treat the real + # copy as authoritative for certain fields. + my $acp = $copy->eg_copy_id; + if ($acp) { + $item_type = $acp->circ_modifier; + $call_number = $acp->call_number->label; + $location = $acp->location->name; + } + + my $found_match = 0; + + # Collapse like copies into groups with a quantity value. + # INCLUDE_COPY_ID implies one GIR row per copy, no collapsing. + if (!$self->{compiled}->{edi_attrs}->{INCLUDE_COPY_ID}) { + + for my $e_copy (@{$li_hash->{copies}}) { + if ( + ($fund eq $e_copy->{fund}) && + ($item_type eq $e_copy->{item_type}) && + ($call_number eq $e_copy->{call_number}) && + ($owning_lib eq $e_copy->{owning_lib}) && + ($location eq $e_copy->{location}) && + ($collection_code eq $e_copy->{collection_code}) + ) { + $e_copy->{quantity}++; + $found_match = 1; + last; + } + } + } + + return if $found_match; # nothing left to do. + + # No matching copy found. Add it as a new copy to the lineitem + # copies array. + + push(@{$li_hash->{copies}}, { + fund => $self->escape_edi($fund), + item_type => $self->escape_edi($item_type), + call_number => $self->escape_edi($call_number), + owning_lib => $self->escape_edi($owning_lib), + location => $self->escape_edi($location), + collection_code => $self->escape_edi($collection_code), + copy_id => $copy->id, # for INCLUDE_COPY_ID + quantity => 1 + }); +} + +# IMD fields are limited to 70 chars per value. Any values longer +# should be carried via repeating IMD fields. +# IMD fields should only display the +::: when a value is present +sub IMD { + my ($self, $code, $value) = @_; + if ($value) { + my $s = ''; + for my $part ($value =~ m/.{1,70}/g) { + $s .= "IMD+F+$code+:::$part'\n"; } + return $s; + + } else { + return "IMD+F+$code'\n" + } +} + +# EDI Segments: -- +# UNA +# UNB +# UNH +# BGM +# DTM +# NAD+BY +# NAD+SU...::31B +# NAD+SU...::92 +# CUX +# +# UNS +# CNT +# UNT +# UNZ +sub build_order_edi { + my ($self) = @_; + my %c = %{$self->{compiled}}; + my $date = DateTime->now->strftime("%Y%m%d"); + my $datetime = DateTime->now->strftime("%y%m%d:%H%M"); + my @lis = @{$c{lineitems}}; + + # EDI header + my $edi = <build_lineitem_segments($_) for @lis; + + my $li_count = scalar(@lis); + + # Count the number of segments in the EDI message by counting the + # number of newlines. Add to count for lines below, not including + # the UNZ segment. + my $segments = $edi =~ tr/\n//; + $segments += 3; # UNS, CNT, UNT + + # EDI Trailer + $edi .= <{compiled}}; + + my $id = $li_hash->{id}; + my $idval = $li_hash->{idval}; + my $idqual = $li_hash->{idqual}; + my $quantity = $li_hash->{quantity}; + my $price = $li_hash->{estimated_unit_price}; + + # Line item identifier segments + my $edi = "LIN+$id++$idval:$idqual'\n"; + $edi .= "PIA+5+$idval:$idqual'\n"; + + $edi .= $self->IMD('BTI', $li_hash->{title}); + $edi .= $self->IMD('BPD', $li_hash->{pubdate}); + $edi .= $self->IMD('BPU', $li_hash->{publisher}); + + $edi .= $self->IMD('BAU', $li_hash->{author}) + if $c{edi_attrs}->{INCLUDE_BIB_AUTHOR}; + + $edi .= $self->IMD('BEN', $li_hash->{edition}) + if $c{edi_attrs}->{INCLUDE_BIB_EDITION}; + + $edi .= $self->IMD('BPH', $li_hash->{pagination}) + if $c{edi_attrs}->{INCLUDE_BIB_PAGINATION}; + + $edi .= "QTY+21:$quantity'\n"; + + $edi .= $self->build_gir_segments($li_hash); + + for my $note (@{$li_hash->{notes}}) { + if ($note) { + $edi .= "FTX+LIN+1+$note'\n" + } else { + $edi .= "FTX+LIN+1'\n" + } + } + + $edi .= "PRI+AAB:$price'\n"; + + # Standard RFF + my $rff = "$c{po_id}/$id"; + + if ($c{edi_attrs}->{LINEITEM_REF_ID_ONLY}) { + # RFF with lineitem ID only (typically B&T) + $rff = $id; + } elsif ($c{edi_attrs}->{INCLUDE_PO_NAME}) { + # RFF with PO name instead of PO ID + $rff = "$c{po_name}/$id"; + } + + $edi .= "RFF+LI:$rff'\n"; + + return $edi; +} + + +# Map of GIR segment codes, copy field names, inclusion attributes, +# and include-if-empty attributes for encoding copy data. +my @gir_fields = ( + { code => 'LLO', + field => 'owning_lib', + attr => 'INCLUDE_OWNING_LIB'}, + { code => 'LFN', + field => 'fund', + attr => 'INCLUDE_FUND'}, + { code => 'LSM', + field => 'call_number', + attr => 'INCLUDE_CALL_NUMBER', + empty_attr => 'INCLUDE_EMPTY_CALL_NUMBER'}, + { code => 'LST', + field => 'item_type', + attr => 'INCLUDE_ITEM_TYPE', + empty_attr => 'INCLUDE_EMPTY_ITEM_TYPE'}, + { code => 'LSQ', + field => 'collection_code', + attr => 'INCLUDE_COLLECTION_CODE', + empty_attr => 'INCLUDE_EMPTY_COLLECTION_CODE'}, + { code => 'LFH', + field => 'location', + attr => 'INCLUDE_LOCATION', + empty_attr => 'INCLUDE_EMPTY_LOCATION'}, + { code => 'LQT', + field => 'quantity', + attr => 'INCLUDE_QUANTITY'} +); + +# EDI Segments: -- +# GIR +# Sub-Segments: -- +# LLO +# LFN +# LSM +# LST +# LSQ +# LFH +# LQT +sub build_gir_segments { + my ($self, $li_hash) = @_; + my %c = %{$self->{compiled}}; + my $gir_index = 0; + my $edi = ''; + + for my $copy (@{$li_hash->{copies}}) { + $gir_index++; + my $gir_idx_str = sprintf("%03d", $gir_index); + + my $field_count = 0; + for my $field (@gir_fields) { + next unless $c{edi_attrs}->{$field->{attr}}; + + my $val = $copy->{$field->{field}}; + my $code = $field->{code}; + + # include the GIR component if we have a value or this + # EDI account is configured to include the empty value + next unless $val || $c{edi_attrs}->{$field->{empty_attr} || ''}; + + # EDI only allows 5 fields per GIR segment. When we exceed + # 5, finalize the in-process GIR segment and add a new one + # as needed. + if ($field_count == 5) { + $field_count = 0; + # Finalize this GIR segment with a ' and newline + $edi .= "'\n"; + } + + $field_count++; + + # Starting a new GIR line for the current copy. + $edi .= "GIR+$gir_idx_str" if $field_count == 1; + + # Add the field-specific value + $edi .= "+$val:$code"; + } + + # End the final GIR segment with a ' and newline + $edi .= "'\n"; + } + + return $edi; +} + +1; + diff --git a/Open-ILS/src/support-scripts/test-scripts/edi_writer.pl b/Open-ILS/src/support-scripts/test-scripts/edi_writer.pl new file mode 100755 index 0000000000..075f2f145e --- /dev/null +++ b/Open-ILS/src/support-scripts/test-scripts/edi_writer.pl @@ -0,0 +1,25 @@ +#!/usr/bin/perl +use strict; use warnings; +use OpenILS::Utils::EDIWriter; +require '../oils_header.pl'; +use OpenILS::Utils::CStoreEditor qw/:funcs/; +use Getopt::Long; + +my $config = '/openils/conf/opensrf_core.xml'; +my $po_id; + +GetOptions( + 'osrf-config' => \$config, + 'po-id=i' => \$po_id +); + + +osrf_connect($config); + +my $writer = OpenILS::Utils::EDIWriter->new({pretty => 1}); +#my $writer = OpenILS::Utils::EDIWriter->new; +my $edi = $writer->write($po_id); + +print "$edi\n"; + + -- 2.11.0