--- /dev/null
+# ---------------------------------------------------------------
+# Copyright (C) 2016 King County Library System
+# Author: Bill Erickson <berickxx@gmail.com>
+#
+# 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 [? + ' \ : <newline>] 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
+# <lineitems and copies>
+# 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 = <<EDI;
+UNA:+.? '
+UNB+UNOB:3+$c{org_unit_san}:31B+$c{vendor_san}:31B+$datetime+1'
+UNH+1+ORDERS:D:96A:UN'
+BGM+220+$c{po_id}+9'
+DTM+137:$date:102'
+NAD+BY+$c{buyer_code}::91'
+NAD+SU+$c{vendor_san}::31B'
+NAD+SU+$c{provider_id}::92'
+CUX+2:$c{currency_type}:9'
+EDI
+
+ # EDI lineitem segments
+ $edi .= $self->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 .= <<EDI;
+UNS+S'
+CNT+2:$li_count'
+UNT+$segments+1'
+UNZ+1+1'
+EDI
+
+ return $edi;
+}
+
+# EDI Segments: --
+# LIN
+# PIA+5
+# IMD+F+BTI
+# IMD+F+BPD
+# IMD+F+BPU
+# IMD+F+BAU
+# IMD+F+BEN
+# IMD+F+BPH
+# QTY+21
+# FTX+LIN
+# PRI+AAB
+# RFF+LI
+sub build_lineitem_segments {
+ my ($self, $li_hash) = @_;
+ my %c = %{$self->{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;
+
projects / working / Evergreen.git / commitdiff