Custom/local EDI reader module for ORDRSP and INVOIC (etc)
[working/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
21 my %edi_fields = (
22     message_type    => qr/^UNH\+\d+\+(\S{6})/,
23     buyer_san       => qr/^NAD\+BY\+([^:]+)/,
24     vendor_san      => qr/^NAD\+SU\+([^:]+)/,
25     purchase_order  => qr/^RFF\+ON:(\S+)/,
26     invoice_ident   => qr/^BGM\+380\+([^\+]+)/,
27     total_billed    => qr/^MOA\+86:(\d+)/
28 );
29
30 my %edi_li_fields = (
31     id      => qr/^RFF\+LI:\S+\/(\S+)/,
32     index   => qr/^LIN\+([^\+]+)/,
33     amount_billed   => qr/^MOA\+203:(\d+)/,
34     net_unit_price  => qr/^PRI\+AAA:(\d+)/,
35     gross_unit_price=> qr/^PRI\+AAB:(\d+)/,
36     expected_date   => qr/^DTM\+44:([^:]+)/
37 );
38
39 my %edi_li_ident_fields = (
40     ident  => qr/^LIN\+\S+\++([^:]+):?(\S+)?/,
41     ident2 => qr/^PIA\+0*5\+([^:]+):?(\S+)?/, 
42 );
43
44 my %edi_li_quant_fields = (
45     code     => qr/^QTY\+(\d+):/,
46     quantity => qr/^QTY\+\d+:(\d+)/
47 );
48
49 my %edi_charge_fields = (
50     charge_type   => qr/^ALC\+C\++([^\+]+)/,
51     charge_amount => qr/^MOA\+(8|131):(\d+)/
52 );
53
54 sub new {
55     return bless({}, shift());
56 }
57
58 # see read()
59 sub read_file {
60     my $self = shift;
61     my $file = shift;
62
63     open(EDI_FILE, $file) or die "Cannot open $file: $!\n";
64     my $edi = join('', <EDI_FILE>);
65     close EDI_FILE;
66
67     return $self->read($edi);
68 }
69
70 # Reads an EDI string and parses the package one "line" at a time, extracting 
71 # needed information via regular expressions.  Returns an array of messages, 
72 # each represented as a hash.  See %edi_*fields above for lists of which fields 
73 # may be present within a message.
74
75 sub read {
76     my $self = shift;
77     my $edi = shift or return [];
78     my @msgs;
79
80     $edi =~ s/\n//og;
81
82     foreach (split(/'/, $edi)) {
83         my $msg = $msgs[-1];
84
85         # - starting a new message
86
87         if (/$NEW_MSG_RE/) { 
88             $msg = {lineitems => [], misc_charges => []};
89             push(@msgs, $msg);
90         }
91
92         # extract top-level message fields
93
94         next unless $msg;
95
96         for my $field (keys %edi_fields) {
97             ($msg->{$field}) = $_ =~ /$edi_fields{$field}/
98                 if /$edi_fields{$field}/;
99         }
100
101         # - starting a new lineitem
102
103         if (/$NEW_LIN_RE/) {
104             $msg->{_current_li} = {};
105             push(@{$msg->{lineitems}}, $msg->{_current_li});
106         }
107
108         # - extract lineitem fields
109
110         if (my $li = $msg->{_current_li}) {
111
112             for my $field (keys %edi_li_fields) {
113                 ($li->{$field}) = $_ =~ /$edi_li_fields{$field}/g
114                     if /$edi_li_fields{$field}/;
115             }
116
117             for my $field (keys %edi_li_ident_fields) {
118                 if (/$edi_li_ident_fields{$field}/) {
119                     my ($ident, $type) = $_ =~ /$edi_li_ident_fields{$field}/;
120                     push(@{$li->{identifiers}}, {code => $type, value => $ident});
121                 }
122             }
123
124             if (/$edi_li_quant_fields{quantity}/) {
125                 my $quant = {};
126                 ($quant->{quantity}) = $_ =~ /$edi_li_quant_fields{quantity}/;
127                 ($quant->{code}) = $_ =~ /$edi_li_quant_fields{code}/;
128                 push(@{$li->{quantities}}, $quant);
129             }
130
131         }
132
133         # - starting a new misc. charge
134
135         if (/$edi_charge_fields{charge_type}/) {
136             $msg->{_current_charge} = {};
137             push (@{$msg->{misc_charges}}, $msg->{_current_charge});
138         }
139
140         # - extract charge fields
141
142         if (my $charge = $msg->{_current_charge}) {
143             for my $field (keys %edi_charge_fields) {
144                 ($charge->{$field}) = $_ =~ /$edi_charge_fields{$field}/
145                     if /$edi_charge_fields{$field}/;
146             }
147         }
148     }
149
150     # remove the state-maintenance keys
151     for my $msg (@msgs) {
152         foreach (grep /^_/, keys %$msg) {
153             delete $msg->{$_};
154         }
155     }
156
157     return \@msgs;
158 }