Koha/Edifact/Message.pm

   1 package Koha::Edifact::Message;
   2
   3 # Copyright 2014,2015 PTFS-Europe Ltd
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # 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 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use strict;
  21 use warnings;
  22 use utf8;
  23
  24 use Koha::Edifact::Line;
  25
  26 sub new {
  27     my ( $class, $data_array_ref ) = @_;
  28     my $header       = shift @{$data_array_ref};
  29     my $bgm          = shift @{$data_array_ref};
  30     my $msg_function = $bgm->elem(2);
  31     my $dtm          = [];
  32     while ( $data_array_ref->[0]->tag eq 'DTM' ) {
  33         push @{$dtm}, shift @{$data_array_ref};
  34     }
  35
  36     my $self = {
  37         function                 => $msg_function,
  38         header                   => $header,
  39         bgm                      => $bgm,
  40         message_reference_number => $header->elem(0),
  41         dtm                      => $dtm,
  42         datasegs                 => $data_array_ref,
  43     };
  44
  45     bless $self, $class;
  46     return $self;
  47 }
  48
  49 sub message_refno {
  50     my $self = shift;
  51     return $self->{message_reference_number};
  52 }
  53
  54 sub function {
  55     my $self         = shift;
  56     my $msg_function = $self->{bgm}->elem(2);
  57     if ( $msg_function == 9 ) {
  58         return 'original';
  59     }
  60     elsif ( $msg_function == 7 ) {
  61         return 'retransmission';
  62     }
  63     return;
  64 }
  65
  66 sub message_reference_number {
  67     my $self = shift;
  68     return $self->{header}->elem(0);
  69 }
  70
  71 sub message_type {
  72     my $self = shift;
  73     return $self->{header}->elem( 1, 0 );
  74 }
  75
  76 sub message_code {
  77     my $self = shift;
  78     return $self->{bgm}->elem( 0, 0 );
  79 }
  80
  81 sub docmsg_number {
  82     my $self = shift;
  83     return $self->{bgm}->elem(1);
  84 }
  85
  86 sub message_date {
  87     my $self = shift;
  88
  89     # usually the first if not only dtm
  90     foreach my $d ( @{ $self->{dtm} } ) {
  91         if ( $d->elem( 0, 0 ) eq '137' ) {
  92             return $d->elem( 0, 1 );
  93         }
  94     }
  95     return;    # this should not happen
  96 }
  97
  98 sub tax_point_date {
  99     my $self = shift;
 100     if ( $self->message_type eq 'INVOIC' ) {
 101         foreach my $d ( @{ $self->{dtm} } ) {
 102             if ( $d->elem( 0, 0 ) eq '131' ) {
 103                 return $d->elem( 0, 1 );
 104             }
 105         }
 106     }
 107     return;
 108 }
 109
 110 sub expiry_date {
 111     my $self = shift;
 112     if ( $self->message_type eq 'QUOTES' ) {
 113         foreach my $d ( @{ $self->{dtm} } ) {
 114             if ( $d->elem( 0, 0 ) eq '36' ) {
 115                 return $d->elem( 0, 1 );
 116             }
 117         }
 118     }
 119     return;
 120 }
 121
 122 sub shipment_charge {
 123     my $self = shift;
 124
 125     # A large number of different charges can be expressed at invoice and
 126     # item level but the only one koha takes cognizance of is shipment
 127     # should we wrap all invoice level charges into it??
 128     if ( $self->message_type eq 'INVOIC' ) {
 129         my $delivery = 0;
 130         my $amt      = 0;
 131         foreach my $s ( @{ $self->{datasegs} } ) {
 132             if ( $s->tag eq 'LIN' ) {
 133                 last;
 134             }
 135             if ( $s->tag eq 'ALC' ) {
 136                 if ( $s->elem(0) eq 'C' ) {    # Its a charge
 137                     if ( $s->elem( 4, 0 ) eq 'DL' ) {    # delivery charge
 138                         $delivery = 1;
 139                     }
 140                 }
 141                 next;
 142             }
 143             if ( $s->tag eq 'MOA' ) {
 144                 $amt += $s->elem( 0, 1 );
 145             }
 146         }
 147         return $amt;
 148     }
 149     return;
 150 }
 151
 152 # return NAD fields
 153
 154 sub buyer_ean {
 155     my $self = shift;
 156     foreach my $s ( @{ $self->{datasegs} } ) {
 157         if ( $s->tag eq 'LIN' ) {
 158             last;
 159         }
 160         if ( $s->tag eq 'NAD' ) {
 161             my $qualifier = $s->elem(0);
 162             if ( $qualifier eq 'BY' ) {
 163                 return $s->elem( 1, 0 );
 164             }
 165         }
 166     }
 167     return;
 168 }
 169
 170 sub supplier_ean {
 171     my $self = shift;
 172     foreach my $s ( @{ $self->{datasegs} } ) {
 173         if ( $s->tag eq 'LIN' ) {
 174             last;
 175         }
 176         if ( $s->tag eq 'NAD' ) {
 177             my $qualifier = $s->elem(0);
 178             if ( $qualifier eq 'SU' ) {
 179                 return $s->elem( 1, 0 );
 180             }
 181         }
 182     }
 183     return;
 184
 185 }
 186
 187 sub lineitems {
 188     my $self = shift;
 189     if ( $self->{quotation_lines} ) {
 190         return $self->{quotation_lines};
 191     }
 192     else {
 193         my $items    = [];
 194         my $item_arr = [];
 195         foreach my $seg ( @{ $self->{datasegs} } ) {
 196             my $tag = $seg->tag;
 197             if ( $tag eq 'LIN' ) {
 198                 if ( @{$item_arr} ) {
 199                     push @{$items}, Koha::Edifact::Line->new($item_arr);
 200                 }
 201                 $item_arr = [$seg];
 202                 next;
 203             }
 204             elsif ( $tag =~ m/^(UNS|CNT|UNT)$/sxm ) {
 205                 if ( @{$item_arr} ) {
 206                     push @{$items}, Koha::Edifact::Line->new($item_arr);
 207                 }
 208                 last;
 209             }
 210             else {
 211                 if ( @{$item_arr} ) {
 212                     push @{$item_arr}, $seg;
 213                 }
 214             }
 215         }
 216         $self->{quotation_lines} = $items;
 217         return $items;
 218     }
 219 }
 220
 221 1;
 222 __END__
 223
 224 =head1 NAME
 225
 226 Koha::Edifact::Message
 227
 228 =head1 DESCRIPTION
 229
 230 Class modelling an Edifact Message for parsing
 231
 232 =head1 METHODS
 233
 234 =head2 new
 235
 236    Passed an array of segments extracts message level info
 237    and parses lineitems as Line objects
 238
 239 =head1 AUTHOR
 240
 241    Colin Campbell <colin.campbell@ptfs-europe.com>
 242
 243 =head1 COPYRIGHT
 244
 245    Copyright 2014,2015 PTFS-Europe Ltd
 246    This program is free software, You may redistribute it under
 247    under the terms of the GNU General Public License
 248
 249 =cut