LP 1519465: POs with spaces in the name cause EDI problems.
[Evergreen.git] / 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 my $END_ALL_LIN = '^UNS'; # no more lineitems after this
21
22 my %edi_fields = (
23     message_type    => qr/^UNH\+[A-z0-9]+\+(\S{6})/,
24     buyer_san       => qr/^NAD\+BY\+([^:]+)::31B/,
25     buyer_acct      => qr/^NAD\+BY\+([^:]+)::91/,
26     vendor_san      => qr/^NAD\+SU\+([^:]+)::31B/,
27     vendor_acct     => qr/^NAD\+SU\+([^:]+)::91/,
28     purchase_order  => qr/^RFF\+ON:(\S+)/,
29     invoice_ident   => qr/^BGM\+380\+([^\+]+)/,
30     total_billed    => qr/^MOA\+86:([^:]+)/,
31     invoice_date    => qr/^DTM\+137:([^:]+)/
32 );
33
34 my %edi_li_fields = (
35     id      => qr/^RFF\+LI:(?:[^\/]+\/)?(\d+)/,
36     index   => qr/^LIN\+([^\+]+)/,
37     amount_billed   => qr/^MOA\+203:([^:]+)/,
38     net_unit_price  => qr/^PRI\+AAA:([^:]+)/,
39     gross_unit_price=> qr/^PRI\+AAB:([^:]+)/,
40     expected_date   => qr/^DTM\+44:([^:]+)/,
41     avail_status    => qr/^FTX\+LIN\++([^:]+):8B:28/,
42     # "1B" codes are deprecated, but still in use.  
43     # Pretend it's "12B" and it should just work
44     order_status    => qr/^FTX\+LIN\++([^:]+):12?B:28/
45 );
46
47 my %edi_li_ident_fields = (
48     ident  => qr/^LIN\+\S+\++([^:]+):?(\S+)?/,
49     ident2 => qr/^PIA\+0*5\+([^:]+):?(\S+)?/, 
50 );
51
52 my %edi_li_quant_fields = (
53     code     => qr/^QTY\+(\d+):/,
54     quantity => qr/^QTY\+\d+:(\d+)/
55 );
56
57 my %edi_charge_fields = (
58     type   => qr/^ALC\+C\++([^\+]+)/,
59     amount => qr/^MOA\+(?:8|131|304):([^:]+)/
60 );
61
62 # This may need to be liberalized later, but it works for the only example I
63 # have so far.
64 my %edi_tax_fields = (
65     type   => qr/^TAX\+7\+([^\+]+)/,
66     amount => qr/^MOA\+124:([^:]+)/
67 );
68
69 sub new {
70     return bless({}, shift());
71 }
72
73 # see read()
74 sub read_file {
75     my $self = shift;
76     my $file = shift;
77
78     open(EDI_FILE, $file) or die "Cannot open $file: $!\n";
79     my $edi = join('', <EDI_FILE>);
80     close EDI_FILE;
81
82     return $self->read($edi);
83 }
84
85 # Reads an EDI string and parses the package one "line" at a time, extracting 
86 # needed information via regular expressions.  Returns an array of messages, 
87 # each represented as a hash.  See %edi_*fields above for lists of which fields 
88 # may be present within a message.
89
90 sub read {
91     my $self = shift;
92     my $edi = shift or return [];
93     my @msgs;
94
95     $edi =~ s/\n//og;
96
97     foreach (split(/'/, $edi)) {
98         my $msg = $msgs[-1];
99
100         # - starting a new message
101
102         if (/$NEW_MSG_RE/) { 
103             $msg = {lineitems => [], misc_charges => [], taxes => []};
104             push(@msgs, $msg);
105         }
106
107         # extract top-level message fields
108
109         next unless $msg;
110
111         for my $field (keys %edi_fields) {
112             ($msg->{$field}) = $_ =~ /$edi_fields{$field}/
113                 if /$edi_fields{$field}/;
114         }
115
116         # - starting a new lineitem
117
118         if (/$NEW_LIN_RE/) {
119             $msg->{_current_li} = {};
120             push(@{$msg->{lineitems}}, $msg->{_current_li});
121         }
122
123         # - extract lineitem fields
124
125         if (my $li = $msg->{_current_li}) {
126
127             for my $field (keys %edi_li_fields) {
128                 ($li->{$field}) = $_ =~ /$edi_li_fields{$field}/g
129                     if /$edi_li_fields{$field}/;
130             }
131
132             for my $field (keys %edi_li_ident_fields) {
133                 if (/$edi_li_ident_fields{$field}/) {
134                     my ($ident, $type) = $_ =~ /$edi_li_ident_fields{$field}/;
135                     push(@{$li->{identifiers}}, {code => $type, value => $ident});
136                 }
137             }
138
139             if (/$edi_li_quant_fields{quantity}/) {
140                 my $quant = {};
141                 ($quant->{quantity}) = $_ =~ /$edi_li_quant_fields{quantity}/;
142                 ($quant->{code}) = $_ =~ /$edi_li_quant_fields{code}/;
143                 push(@{$li->{quantities}}, $quant);
144             }
145
146         }
147
148         # - starting a new misc. charge
149
150         if (/$edi_charge_fields{type}/) {
151             $msg->{_current_charge} = {};
152             push (@{$msg->{misc_charges}}, $msg->{_current_charge});
153         }
154
155         # - extract charge fields
156
157         if (my $charge = $msg->{_current_charge}) {
158             for my $field (keys %edi_charge_fields) {
159                 ($charge->{$field}) = $_ =~ /$edi_charge_fields{$field}/
160                     if /$edi_charge_fields{$field}/;
161             }
162         }
163
164         # - starting a new tax charge.  Taxes wind up on current lineitem if
165         # any, otherwise in the top-level taxes array
166
167         if (/$edi_tax_fields{type}/) {
168             $msg->{_current_tax} = {};
169             if ($msg->{_current_li}) {
170                 $msg->{_current_li}{tax} = $msg->{_current_tax}
171             } else {
172                 push (@{$msg->{taxes}}, $msg->{_current_tax});
173             }
174         }
175
176         # - extract tax field
177
178         if (my $tax = $msg->{_current_tax}) {
179             for my $field (keys %edi_tax_fields) {
180                 ($tax->{$field}) = $_ =~ /$edi_tax_fields{$field}/
181                     if /$edi_tax_fields{$field}/;
182             }
183         }
184
185         # This helps avoid associating taxes and charges at the end of the
186         # message with the final lineitem inapporiately.
187         if (/$END_ALL_LIN/) {
188             # remove the state-maintenance keys
189             foreach (grep /^_/, keys %$msg) {
190                 delete $msg->{$_};
191             }
192         }
193     }
194
195     # remove the state-maintenance keys
196     for my $msg (@msgs) {
197         foreach (grep /^_/, keys %$msg) {
198             delete $msg->{$_};
199         }
200     }
201
202     return \@msgs;
203 }