1 # ---------------------------------------------------------------
2 # Copyright (C) 2016 King County Library System
3 # Author: Bill Erickson <berickxx@gmail.com>
5 # Copied heavily from Application/Trigger/Reactor.pm
7 # This program is free software; you can redistribute it and/or
8 # modify it under the terms of the GNU General Public License
9 # as published by the Free Software Foundation; either version 2
10 # of the License, or (at your option) any later version.
12 # This program is distributed in the hope that it will be useful,
13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
16 # ---------------------------------------------------------------
17 package OpenILS::Utils::EDIWriter;
18 use strict; use warnings;
19 use OpenILS::Utils::CStoreEditor qw/:funcs/;
20 use OpenILS::Application::AppUtils;
22 my $U = 'OpenILS::Application::AppUtils';
25 my ($class, $args) = @_;
27 return bless($args, $class);
30 # Returns EDI string on success, undef on error.
32 my ($self, $po_id, $msg_type) = @_;
33 $msg_type ||= 'order';
35 my $po = $self->get_po($po_id);
36 return undef unless $po;
38 $self->compile_po($po);
39 return undef unless $self->{compiled};
41 my $edi = $self->build_order_edi if $msg_type eq 'order';
43 # remove the newlines unless we are pretty printing
44 $edi =~ s/\n//g unless $self->{pretty};
50 my ($self, $po_id) = @_;
51 return new_editor()->retrieve_acq_purchase_order([
55 acqpo => [qw/lineitems ordering_agency provider/],
56 acqpro => [qw/edi_default/],
57 acqedi => [qw/attr_set/],
58 aeas => [qw/attr_maps/],
59 jub => [qw/lineitem_details lineitem_notes attributes/],
60 acqlid => [qw/owning_lib location fund eg_copy_id/],
61 acp => [qw/location call_number/],
62 aou => [qw/mailing_address/]
68 sub add_release_characters {
69 my ($self, $value) = @_;
70 return '' if (not defined $value || ref($value));
72 # escape ? ' + : with the release character ?
73 $value =~ s/([\?'\+:])/?$1/g;
78 my ($self, $value) = @_;
79 return '' if (not defined $value || ref($value));
81 # Typical vendors dealing with EDIFACT (or is the problem with
82 # our EDI translator itself?) would seem not to want
83 # any characters outside the ASCII range, so trash them.
84 $value =~ s/[^[:ascii:]]//g;
86 # What the heck, get rid of [ ] too (although I couldn't get them
87 # to cause any problems for me, problems have been reported. See
89 $value =~ s/[\[\]]//g;
91 # Characters [\ <newline>] are all potentially problematic for
92 # EDI messages, regardless of their position in the string.
93 # Safest to simply remove them. Note that unlike escape_edi(),
94 # we're not stripping out +, ', :, and + because we'll escape
95 # them when buidling IMD segments
98 # Replace newlines with spaces.
104 my ($self, $value) = @_;
106 my $str = $self->escape_edi_imd($value);
108 # further strip + ' : +
109 $str =~ s/[\?\+':]//g;
114 # Returns an EDI-escaped version of the requested lineitem attribute
115 # value. If $attr_type is not set, the first attribute found matching
116 # the requested $attr_name will be used.
118 my ($self, $li, $attr_name, $attr_type) = @_;
120 for my $attr (@{$li->attributes}) {
121 next unless $attr->attr_name eq $attr_name;
122 next if $attr_type && $attr->attr_type ne $attr_type;
123 return $self->escape_edi($attr->attr_value);
129 # Like get_li_attr, but don't strip out ? + : ' as we'll
131 sub get_li_attr_imd {
132 my ($self, $li, $attr_name, $attr_type) = @_;
134 for my $attr (@{$li->attributes}) {
135 next unless $attr->attr_name eq $attr_name;
136 next if $attr_type && $attr->attr_type ne $attr_type;
137 return $self->escape_edi_imd($attr->attr_value);
143 # Generates a HASH version of the PO with all of the data necessary
144 # to generate an EDI message from the PO.
146 my ($self, $po) = @_;
148 # Cannot generate EDI if the PO has no linked EDI account.
149 return undef unless $po->provider->edi_default;
153 po_name => $self->escape_edi($po->name),
154 provider_id => $po->provider->id,
155 vendor_san => $po->provider->san || '',
156 org_unit_san => $po->ordering_agency->mailing_address->san || '',
157 currency_type => $po->provider->currency_type,
162 $self->{compiled} = \%compiled;
164 if ($po->provider->edi_default->attr_set) {
165 $compiled{edi_attrs}{$_->attr} = 1
166 for @{$po->provider->edi_default->attr_set->attr_maps}
169 $compiled{buyer_code} = $po->provider->edi_default->vendacct;
171 $compiled{buyer_code} = # B&T
172 $compiled{org_unit_san}.' '.$po->provider->edi_default->vendcode
173 if $compiled{edi_attrs}->{BUYER_ID_INCLUDE_VENDCODE};
175 $compiled{buyer_code} = $po->provider->edi_default->vendcode
176 if $compiled{edi_attrs}->{BUYER_ID_ONLY_VENDCODE}; # MLS
178 push(@{$compiled{lineitems}},
179 $self->compile_li($_)) for @{$po->lineitems};
184 # Translate a lineitem order identifier attribute into an
185 # EDI ID value and ID qualifier.
186 sub set_li_order_ident {
187 my ($self, $li, $li_hash) = @_;
189 my $idqual = 'EN'; # ISBN13
192 if ($self->{compiled}->{edi_attr}->{LINEITEM_IDENT_VENDOR_NUMBER}) {
193 # See if we have a vendor-specific lineitem identifier value
194 $idval = $self->get_li_attr($li, 'vendor_num');
199 my $attr = $self->get_li_order_ident_attr($li->attributes);
202 my $name = $attr->attr_name;
203 $idval = $attr->attr_value;
205 if ($name eq 'isbn' && length($idval) != 13) {
207 } elsif ($name eq 'issn') {
216 $li_hash->{idqual} = $idqual;
217 $li_hash->{idval} = $idval;
220 # Find the acq.lineitem_attr object that represents the identifier
222 sub get_li_order_ident_attr {
223 my ($self, $attrs) = @_;
225 # preferred identifier
226 my ($attr) = grep { $U->is_true($_->order_ident) } @$attrs;
227 return $attr if $attr;
229 # note we're not using get_li_attr, since we need the
230 # attr object and not just the attr value
234 $_->attr_name eq 'isbn' and
235 $_->attr_type eq 'lineitem_marc_attr_definition' and
236 length($_->attr_value) == 13
238 return $attr if $attr;
240 for my $name (qw/isbn issn upc/) {
242 $_->attr_name eq $name and
243 $_->attr_type eq 'lineitem_marc_attr_definition'
245 return $attr if $attr;
248 # any 'identifier' attr
249 return (grep { $_->attr_name eq 'identifier' } @$attrs)[0];
252 # Collect FTX notes and chop them into FTX-compatible values.
254 my ($self, $li) = @_;
256 # all vendor-public, non-empty lineitem notes
259 grep { $U->is_true($_->vendor_public) && $_->value }
260 @{$li->lineitem_notes};
262 if ($self->{compiled}->{edi_attr}->{COPY_SPEC_CODES}) {
263 for my $lid (@{$li->lineitem_details}) {
264 push(@notes, $lid->note)
265 if ($lid->note || '') =~ /spec code [a-zA-Z0-9_]/;
271 if (!@notes && $self->{compiled}->{edi_attr}->{INCLUDE_EMPTY_LI_NOTE}) {
272 # lineitem has no notes. Add a blank note if needed.
273 push(@trimmed_notes, '');
276 # EDI FTX fields have a max length of 512
277 # While we're in here, EDI-escape the note values
278 for my $note (@notes) {
279 $note = $self->escape_edi($note);
280 my @parts = ($note =~ m/.{1,512}/g);
281 push(@trimmed_notes, @parts);
285 return \@trimmed_notes;
289 my ($self, $li) = @_;
293 quantity => scalar(@{$li->lineitem_details}),
294 estimated_unit_price => $li->estimated_unit_price || '0.00',
295 notes => $self->get_li_ftx($li),
299 $self->set_li_order_ident($li, $li_hash);
301 for my $name (qw/title author edition pubdate publisher pagination/) {
302 $li_hash->{$name} = $self->get_li_attr_imd($li, $name);
305 $self->compile_copies($li, $li_hash);
311 my ($self, $li, $li_hash) = @_;
313 # does this EDI account want copy data?
314 return unless $self->{compiled}->{edi_attrs}->{INCLUDE_COPIES};
316 for my $copy (@{$li->lineitem_details}) {
317 $self->compile_copy($li, $li_hash, $copy);
322 my ($self, $li, $li_hash, $copy) = @_;
324 my $fund = $copy->fund ? $copy->fund->code : '';
325 my $item_type = $copy->circ_modifier || '';
326 my $call_number = $copy->cn_label || '';
327 my $owning_lib = $copy->owning_lib ?
328 $self->{compiled}->{edi_attrs}->{USE_ID_FOR_OWNING_LIB} ?
329 $copy->owning_lib->id :
330 $copy->owning_lib->shortname :
332 my $location = $copy->location ? $copy->location->name : '';
333 my $collection_code = $copy->collection_code || '';
334 my $barcode = $copy->barcode || '';
337 # When an ACQ copy links to a real copy (acp), treat the real
338 # copy as authoritative for certain fields.
339 my $acp = $copy->eg_copy_id;
341 $item_type = $acp->circ_modifier || '';
342 $call_number = $acp->call_number->label;
343 $location = $acp->location->name;
348 # Collapse like copies into groups with a quantity value.
349 # INCLUDE_COPY_ID implies one GIR row per copy, no collapsing.
350 if (!$self->{compiled}->{edi_attrs}->{INCLUDE_COPY_ID}) {
352 for my $e_copy (@{$li_hash->{copies}}) {
354 ($fund eq $e_copy->{fund}) &&
355 ($item_type eq $e_copy->{item_type}) &&
356 ($call_number eq $e_copy->{call_number}) &&
357 ($owning_lib eq $e_copy->{owning_lib}) &&
358 ($location eq $e_copy->{location}) &&
359 ($barcode eq $e_copy->{barcode}) &&
360 ($collection_code eq $e_copy->{collection_code})
362 $e_copy->{quantity}++;
369 return if $found_match; # nothing left to do.
371 # No matching copy found. Add it as a new copy to the lineitem
374 push(@{$li_hash->{copies}}, {
375 fund => $self->escape_edi($fund),
376 item_type => $self->escape_edi($item_type),
377 call_number => $self->escape_edi($call_number),
378 owning_lib => $self->escape_edi($owning_lib),
379 location => $self->escape_edi($location),
380 barcode => $self->escape_edi($barcode),
381 collection_code => $self->escape_edi($collection_code),
382 copy_id => $copy->id, # for INCLUDE_COPY_ID
387 # IMD fields are limited to 70 chars per value over two DEs.
388 # Any values longer # should be carried via repeating IMD fields.
389 # IMD fields should only display the +::: when a value is present
391 my ($self, $code, $value) = @_;
395 $self->{compiled}->{edi_attrs}->{INCLUDE_EMPTY_IMD_VALUES}
400 for my $part ($value =~ m/.{1,70}/g) {
402 if (length($part) > 35) {
403 $de = $self->add_release_characters(substr($part, 0, 35)) .
405 $self->add_release_characters(substr($part, 35));
407 $de = $self->add_release_characters($part);
409 $s .= "IMD+F+$code+:::$de'\n";
414 return "IMD+F+$code'\n"
428 # <lineitems and copies>
433 sub build_order_edi {
435 my %c = %{$self->{compiled}};
436 my $date = DateTime->now->strftime("%Y%m%d");
437 my $datetime = DateTime->now->strftime("%y%m%d:%H%M");
438 my @lis = @{$c{lineitems}};
443 UNB+UNOB:3+$c{org_unit_san}:31B+$c{vendor_san}:31B+$datetime+1'
444 UNH+1+ORDERS:D:96A:UN'
449 $edi .= "NAD+BY+$c{org_unit_san}::31B'\n" unless (
450 $self->{compiled}->{edi_attrs}->{BUYER_ID_ONLY_VENDCODE} ||
451 $self->{compiled}->{edi_attrs}->{BUYER_ID_INCLUDE_VENDCODE}
455 NAD+BY+$c{buyer_code}::91'
456 NAD+SU+$c{vendor_san}::31B'
457 NAD+SU+$c{provider_id}::92'
458 CUX+2:$c{currency_type}:9'
461 # EDI lineitem segments
462 $edi .= $self->build_lineitem_segments($_) for @lis;
464 my $li_count = scalar(@lis);
466 # Count the number of segments in the EDI message by counting the
467 # number of newlines. Add to count for lines below, not including
469 my $segments = $edi =~ tr/\n//;
470 $segments += 1; # UNS, CNT, UNT, but not UNA or UNB
496 sub build_lineitem_segments {
497 my ($self, $li_hash) = @_;
498 my %c = %{$self->{compiled}};
500 my $id = $li_hash->{id};
501 my $idval = $li_hash->{idval};
502 my $idqual = $li_hash->{idqual};
503 my $quantity = $li_hash->{quantity};
504 my $price = $li_hash->{estimated_unit_price};
506 # Line item identifier segments
507 my $edi = "LIN+$id++$idval:$idqual'\n";
508 $edi .= "PIA+5+$idval:$idqual'\n";
510 $edi .= $self->IMD('BTI', $li_hash->{title});
511 $edi .= $self->IMD('BPU', $li_hash->{publisher});
512 $edi .= $self->IMD('BPD', $li_hash->{pubdate});
514 $edi .= $self->IMD('BEN', $li_hash->{edition})
515 if $c{edi_attrs}->{INCLUDE_BIB_EDITION};
517 $edi .= $self->IMD('BAU', $li_hash->{author})
518 if $c{edi_attrs}->{INCLUDE_BIB_AUTHOR};
520 $edi .= $self->IMD('BPH', $li_hash->{pagination})
521 if $c{edi_attrs}->{INCLUDE_BIB_PAGINATION};
523 $edi .= "QTY+21:$quantity'\n";
525 $edi .= $self->build_gir_segments($li_hash);
527 for my $note (@{$li_hash->{notes}}) {
529 $edi .= "FTX+LIN+1+$note'\n"
531 $edi .= "FTX+LIN+1'\n"
535 $edi .= "PRI+AAB:$price'\n";
538 my $rff = "$c{po_id}/$id";
540 if ($c{edi_attrs}->{LINEITEM_REF_ID_ONLY}) {
541 # RFF with lineitem ID only (typically B&T)
543 } elsif ($c{edi_attrs}->{INCLUDE_PO_NAME}) {
544 # RFF with PO name instead of PO ID
545 $rff = "$c{po_name}/$id";
548 $edi .= "RFF+LI:$rff'\n";
554 # Map of GIR segment codes, copy field names, inclusion attributes,
555 # and include-if-empty attributes for encoding copy data.
558 field => 'owning_lib',
559 attr => 'INCLUDE_OWNING_LIB'},
561 field => 'collection_code',
562 attr => 'INCLUDE_COLLECTION_CODE',
563 empty_attr => 'INCLUDE_EMPTY_COLLECTION_CODE'},
566 attr => 'INCLUDE_QUANTITY'},
569 attr => 'INCLUDE_COPY_ID'},
571 field => 'item_type',
572 attr => 'INCLUDE_ITEM_TYPE',
573 empty_attr => 'INCLUDE_EMPTY_ITEM_TYPE'},
575 field => 'call_number',
576 attr => 'INCLUDE_CALL_NUMBER',
577 empty_attr => 'INCLUDE_EMPTY_CALL_NUMBER'},
580 attr => 'INCLUDE_FUND'},
583 attr => 'INCLUDE_LOCATION',
584 empty_attr => 'INCLUDE_EMPTY_LOCATION'},
587 attr => 'INCLUDE_ITEM_BARCODE'}
600 sub build_gir_segments {
601 my ($self, $li_hash) = @_;
602 my %c = %{$self->{compiled}};
606 for my $copy (@{$li_hash->{copies}}) {
608 my $gir_idx_str = sprintf("%03d", $gir_index);
611 for my $field (@gir_fields) {
612 next unless $c{edi_attrs}->{$field->{attr}};
614 my $val = $copy->{$field->{field}};
615 my $code = $field->{code};
617 # include the GIR component if we have a value or this
618 # EDI account is configured to include the empty value
619 next unless $val || $c{edi_attrs}->{$field->{empty_attr} || ''};
621 # EDI only allows 5 fields per GIR segment. When we exceed
622 # 5, finalize the in-process GIR segment and add a new one
624 if ($field_count == 5) {
626 # Finalize this GIR segment with a ' and newline
632 # Starting a new GIR line for the current copy.
633 $edi .= "GIR+$gir_idx_str" if $field_count == 1;
635 # Add the field-specific value
636 $edi .= "+$val:$code";
639 # End the final GIR segment with a ' and newline