Koha/Edifact/Segment.pm

   1 package Koha::Edifact::Segment;
   2
   3 # Copyright 2014,2016 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 sub new {
  25     my ( $class, $parm_ref ) = @_;
  26     my $self = {};
  27     if ( $parm_ref->{seg_string} ) {
  28         $self = _parse_seg( $parm_ref->{seg_string} );
  29     }
  30
  31     bless $self, $class;
  32     return $self;
  33 }
  34
  35 sub tag {
  36     my $self = shift;
  37     return $self->{tag};
  38 }
  39
  40 # return specified element may be data or an array ref if components
  41 sub elem {
  42     my ( $self, $element_number, $component_number ) = @_;
  43     if ( $element_number < @{ $self->{elem_arr} } ) {
  44
  45         my $e = $self->{elem_arr}->[$element_number];
  46         if ( defined $component_number ) {
  47             if ( ref $e eq 'ARRAY' ) {
  48                 if ( $component_number < @{$e} ) {
  49                     return $e->[$component_number];
  50                 }
  51             }
  52             elsif ( $component_number == 0 ) {
  53
  54                 # a string could be an element with a single component
  55                 return $e;
  56             }
  57             return;
  58         }
  59         else {
  60             return $e;
  61         }
  62     }
  63     return;    #element undefined ( out of range
  64 }
  65
  66 sub element {
  67     my ( $self, @params ) = @_;
  68
  69     return $self->elem(@params);
  70 }
  71
  72 sub as_string {
  73     my $self = shift;
  74
  75     my $string = $self->{tag};
  76     foreach my $e ( @{ $self->{elem_arr} } ) {
  77         $string .= q|+|;
  78         if ( ref $e eq 'ARRAY' ) {
  79             $string .= join q{:}, @{$e};
  80         }
  81         else {
  82             $string .= $e;
  83         }
  84     }
  85
  86     return $string;
  87 }
  88
  89 # parse a string into fields
  90 sub _parse_seg {
  91     my $s = shift;
  92     my $e = {
  93         tag      => substr( $s,                0, 3 ),
  94         elem_arr => _get_elements( substr( $s, 3 ) ),
  95     };
  96     return $e;
  97 }
  98
  99 ##
 100 # String parsing
 101 #
 102
 103 sub _get_elements {
 104     my $seg = shift;
 105
 106     $seg =~ s/^[+]//;    # dont start with a dummy element`
 107     my @elem_array = map { _components($_) } split /(?<![?])[+]/, $seg;
 108
 109     return \@elem_array;
 110 }
 111
 112 sub _components {
 113     my $element = shift;
 114     my @c = split /(?<![?])[:]/, $element;
 115     if ( @c == 1 ) {     # single element return a string
 116         return de_escape( $c[0] );
 117     }
 118     @c = map { de_escape($_) } @c;
 119     return \@c;
 120 }
 121
 122 sub de_escape {
 123     my $string = shift;
 124
 125     # remove escaped characters from the component string
 126     $string =~ s/[?]([:?+'])/$1/g;
 127     return $string;
 128 }
 129 1;
 130 __END__
 131
 132 =head1 NAME
 133
 134 Koha::Edifact::Segment - Class foe Edifact Segments
 135
 136 =head1 DESCRIPTION
 137
 138  Used by Koha::Edifact to represent segments in a parsed Edifact message
 139
 140
 141 =head1 METHODS
 142
 143 =head2 new
 144
 145      my $s = Koha::Edifact::Segment->new( { seg_string => $raw });
 146
 147      passed a string representation of the segment,  parses it
 148      and retums a Segment object
 149
 150 =head2 tag
 151
 152      returns the three character segment tag
 153
 154 =head2 elem
 155
 156       $data = $s->elem($element_number, $component_number)
 157       return the contents of a specified element and if specified
 158       component of that element
 159
 160 =head2 element
 161
 162       syntactic sugar this wraps the rlem method in a fuller name
 163
 164 =head2 as_string
 165
 166       returns a string representation of the segment
 167
 168 =head2 _parse_seg
 169
 170    passed a string representation of a segment returns a hash ref with
 171    separate tag and data elements
 172
 173 =head2 _get_elements
 174
 175    passed the data portion of a segment, splits it into elements, passing each to
 176    components to further parse them. Returns a reference to an array of
 177    elements
 178
 179 =head2 _components
 180
 181    Passed a string element splits it into components  and returns a reference
 182    to an array of components, if only one component is present that is returned
 183    directly.
 184    quote characters are removed from the components
 185
 186 =head2 de_escape
 187
 188    Removes Edifact escapes from the passed string and returns the modified
 189    string
 190
 191
 192 =head1 AUTHOR
 193
 194    Colin Campbell <colin.campbell@ptfs-europe.com>
 195
 196
 197 =head1 COPYRIGHT
 198
 199    Copyright 2014,2016, PTFS-Europe Ltd
 200    This program is free software, You may redistribute it under
 201    under the terms of the GNU General Public License
 202
 203
 204 =cut