Open-ILS/src/perlmods/lib/OpenILS/Utils/EDIReader.pm

   1 # ---------------------------------------------------------------
   2 # Copyright (C) 2012 Equinox Software, Inc
   3 # Author: Bill Erickson <berickr@esilibrary.com>
   4 #
   5 # This program is free software; you can redistribute it and/or
   6 # modify it under the terms of the GNU General Public License
   7 # as published by the Free Software Foundation; either version 2
   8 # of the License, or (at your option) any later version.
   9
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 # ---------------------------------------------------------------
  15 package OpenILS::Utils::EDIReader;
  16 use strict; use warnings;
  17
  18 my $NEW_MSG_RE = '^UNH'; # starts a new message
  19 my $NEW_LIN_RE = '^LIN'; # starts a new line item
  20
  21 my %edi_fields = (
  22     message_type    => qr/^UNH\+\d+\+(\S{6})/,
  23     buyer_san       => qr/^NAD\+BY\+([^:]+)::31B/,
  24     buyer_acct      => qr/^NAD\+BY\+([^:]+)::91/,
  25     vendor_san      => qr/^NAD\+SU\+([^:]+)::31B/,
  26     vendor_acct     => qr/^NAD\+SU\+([^:]+)::91/,
  27     purchase_order  => qr/^RFF\+ON:(\S+)/,
  28     invoice_ident   => qr/^BGM\+380\+([^\+]+)/,
  29     total_billed    => qr/^MOA\+86:(\d+)/,
  30     invoice_date    => qr/^DTM\+137:([^:]+)/
  31 );
  32
  33 my %edi_li_fields = (
  34     id      => qr/^RFF\+LI:\S+\/(\S+)/,
  35     index   => qr/^LIN\+([^\+]+)/,
  36     amount_billed   => qr/^MOA\+203:(\d+)/,
  37     net_unit_price  => qr/^PRI\+AAA:(\d+)/,
  38     gross_unit_price=> qr/^PRI\+AAB:(\d+)/,
  39     expected_date   => qr/^DTM\+44:([^:]+)/,
  40     avail_status    => qr/^FTX\+LIN\++([^:]+):8B:28/,
  41     # "1B" codes are deprecated, but still in use.
  42     # Pretend it's "12B" and it should just work
  43     order_status    => qr/^FTX\+LIN\++([^:]+):12?B:28/
  44 );
  45
  46 my %edi_li_ident_fields = (
  47     ident  => qr/^LIN\+\S+\++([^:]+):?(\S+)?/,
  48     ident2 => qr/^PIA\+0*5\+([^:]+):?(\S+)?/,
  49 );
  50
  51 my %edi_li_quant_fields = (
  52     code     => qr/^QTY\+(\d+):/,
  53     quantity => qr/^QTY\+\d+:(\d+)/
  54 );
  55
  56 my %edi_charge_fields = (
  57     charge_type   => qr/^ALC\+C\++([^\+]+)/,
  58     charge_amount => qr/^MOA\+(8|131):(\d+)/
  59 );
  60
  61 sub new {
  62     return bless({}, shift());
  63 }
  64
  65 # see read()
  66 sub read_file {
  67     my $self = shift;
  68     my $file = shift;
  69
  70     open(EDI_FILE, $file) or die "Cannot open $file: $!\n";
  71     my $edi = join('', <EDI_FILE>);
  72     close EDI_FILE;
  73
  74     return $self->read($edi);
  75 }
  76
  77 # Reads an EDI string and parses the package one "line" at a time, extracting
  78 # needed information via regular expressions.  Returns an array of messages,
  79 # each represented as a hash.  See %edi_*fields above for lists of which fields
  80 # may be present within a message.
  81
  82 sub read {
  83     my $self = shift;
  84     my $edi = shift or return [];
  85     my @msgs;
  86
  87     $edi =~ s/\n//og;
  88
  89     foreach (split(/'/, $edi)) {
  90         my $msg = $msgs[-1];
  91
  92         # - starting a new message
  93
  94         if (/$NEW_MSG_RE/) {
  95             $msg = {lineitems => [], misc_charges => []};
  96             push(@msgs, $msg);
  97         }
  98
  99         # extract top-level message fields
 100
 101         next unless $msg;
 102
 103         for my $field (keys %edi_fields) {
 104             ($msg->{$field}) = $_ =~ /$edi_fields{$field}/
 105                 if /$edi_fields{$field}/;
 106         }
 107
 108         # - starting a new lineitem
 109
 110         if (/$NEW_LIN_RE/) {
 111             $msg->{_current_li} = {};
 112             push(@{$msg->{lineitems}}, $msg->{_current_li});
 113         }
 114
 115         # - extract lineitem fields
 116
 117         if (my $li = $msg->{_current_li}) {
 118
 119             for my $field (keys %edi_li_fields) {
 120                 ($li->{$field}) = $_ =~ /$edi_li_fields{$field}/g
 121                     if /$edi_li_fields{$field}/;
 122             }
 123
 124             for my $field (keys %edi_li_ident_fields) {
 125                 if (/$edi_li_ident_fields{$field}/) {
 126                     my ($ident, $type) = $_ =~ /$edi_li_ident_fields{$field}/;
 127                     push(@{$li->{identifiers}}, {code => $type, value => $ident});
 128                 }
 129             }
 130
 131             if (/$edi_li_quant_fields{quantity}/) {
 132                 my $quant = {};
 133                 ($quant->{quantity}) = $_ =~ /$edi_li_quant_fields{quantity}/;
 134                 ($quant->{code}) = $_ =~ /$edi_li_quant_fields{code}/;
 135                 push(@{$li->{quantities}}, $quant);
 136             }
 137
 138         }
 139
 140         # - starting a new misc. charge
 141
 142         if (/$edi_charge_fields{charge_type}/) {
 143             $msg->{_current_charge} = {};
 144             push (@{$msg->{misc_charges}}, $msg->{_current_charge});
 145         }
 146
 147         # - extract charge fields
 148
 149         if (my $charge = $msg->{_current_charge}) {
 150             for my $field (keys %edi_charge_fields) {
 151                 ($charge->{$field}) = $_ =~ /$edi_charge_fields{$field}/
 152                     if /$edi_charge_fields{$field}/;
 153             }
 154         }
 155     }
 156
 157     # remove the state-maintenance keys
 158     for my $msg (@msgs) {
 159         foreach (grep /^_/, keys %$msg) {
 160             delete $msg->{$_};
 161         }
 162     }
 163
 164     return \@msgs;
 165 }