3 # Copyright 2014,2015 PTFS-Europe Ltd
5 # This file is part of Koha.
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.
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.
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>.
22 use File::Slurp qw( read_file );
23 use Carp qw( carp croak );
24 use Koha::Edifact::Segment;
25 use Koha::Edifact::Message;
37 my ( $class, $param_hashref ) = @_;
41 if ( $param_hashref->{filename} ) {
42 if ( $param_hashref->{transmission} ) {
44 "Cannot instantiate $class : both filename and transmission passed";
47 $transmission = read_file( $param_hashref->{filename} );
50 $transmission = $param_hashref->{transmission};
52 $self->{transmission} = _init($transmission);
58 sub interchange_header {
59 my ( $self, $field ) = @_;
65 interchange_control_reference => 4,
66 application_reference => 6,
68 if ( !exists $element{$field} ) {
69 carp "No interchange header field $field available";
72 my $data = $self->{transmission}->[0]->elem( $element{$field} );
76 sub interchange_trailer {
77 my ( $self, $field ) = @_;
78 my $trailer = $self->{transmission}->[-1];
79 if ( $field eq 'interchange_control_count' ) {
80 return $trailer->elem(0);
82 elsif ( $field eq 'interchange_control_reference' ) {
83 return $trailer->elem(1);
85 carp "Trailer field $field not recognized";
89 sub new_data_iterator {
92 while ( $self->{transmission}->[$offset]->tag() ne 'UNH' ) {
94 if ( $offset == @{ $self->{transmission} } ) {
95 carp 'Cannot find message start';
99 $self->{data_iterator} = $offset;
105 if ( defined $self->{data_iterator} ) {
106 my $seg = $self->{transmission}->[ $self->{data_iterator} ];
107 if ( $seg->tag eq 'UNH' ) {
109 $self->{msg_type} = $seg->elem( 1, 0 );
111 elsif ( $seg->tag eq 'LIN' ) {
112 $self->{msg_type} = 'detail';
115 if ( $seg->tag ne 'UNZ' ) {
116 $self->{data_iterator}++;
119 $self->{data_iterator} = undef;
126 # for debugging return whole transmission
127 sub get_transmission {
130 return $self->{transmission};
135 return $self->{msg_type};
143 if ( $msg =~ s/^UNA(.{6})// ) {
144 if ( service_string_advice($1) ) {
145 return segmentize($msg);
151 my $s = substr $msg, 10;
152 croak "File does not start with a Service string advice :$s";
156 # return an array of Message objects
160 # return an array of array_refs 1 ref to a message
164 foreach my $seg ( @{ $self->{transmission} } ) {
165 if ( $seg->tag eq 'UNH' ) {
169 elsif ( $seg->tag eq 'UNT' ) {
172 push @{$msg_arr}, Koha::Edifact::Message->new($msg);
184 # internal parsing routines used in _init
186 sub service_string_advice {
189 # At present this just validates that the ssa
190 # is standard Edifact
191 # TBD reset the seps if non standard
192 if ( $ssa ne q{:+.? '} ) {
193 carp " Non standard Service String Advice [$ssa]";
197 # else use default separators
204 # In practice edifact uses latin-1 but check
205 # Transport now converts to utf-8 on ingest
206 # Do not convert here
207 #my $char_set = 'iso-8859-1';
208 #if ( $raw =~ m/^UNB[+]UNO(.)/ ) {
209 # $char_set = msgcharset($1);
211 #from_to( $raw, $char_set, 'utf8' );
214 (?> # dont backtrack into this group
215 [?]. # either the escape character
216 # followed by any other character
218 [^'?] # a character that is neither escape
223 while ( $raw =~ /($re)/g ) {
224 push @segmented, Koha::Edifact::Segment->new( { seg_string => $1 } );
231 if ( $code =~ m/^[^ABCDEF]$/ ) {
241 default => 'iso-8859-1',
243 return $encoding_map{$code};
251 Edifact - Edifact message handler
255 Koha module for parsing Edifact messages
261 my $e = Koha::Edifact->new( { filename => 'myfilename' } );
263 my $e = Koha::Edifact->new( { transmission => $msg_variable } );
265 instantiate the Edifact parser, requires either to be passed an in-memory
266 edifact message as transmission or a filename which it will read on creation
268 =head2 interchange_header
270 will return the data in the header field designated by the parameter
271 specified. Valid parameters are: 'sender', 'recipient', 'datetime',
272 'interchange_control_reference', and 'application_reference'
274 =head2 interchange_trailer
276 called either with the string 'interchange_control_count' or
277 'interchange_control_reference' will return the corresponding field from
278 the interchange trailer
280 =head2 new_data_iterator
282 Sets the object's data_iterator to point to the UNH segment
286 Returns the next segment pointed to by the data_iterator. Increments the
287 data_iterator member or destroys it if segment UNZ has been reached
289 =head2 get_transmission
291 This method is useful in debugg:ing. Call on an Edifact object
292 it returns the object's transmission member
296 return the object's message type
300 return an array of Message objects contained in the Edifact transmission
302 =head1 Internal Methods
306 Called by the constructor to do the parsing of the transmission
308 =head2 service_string_advice
310 Examines the Service String Advice returns 1 if the default separartors are in use
315 takes a raw Edifact message and returns a reference to an array of
320 Return the character set the message was encoded in. The default is iso-8859-1
322 We preserve this info but will have converted to utf-8 on ingest
326 Colin Campbell <colin.campbell@ptfs-europe.com>
331 Copyright 2014,2015, PTFS-Europe Ltd
332 This program is free software, You may redistribute it under
333 under the terms of the GNU General Public License