From 21f62f04caaabf8fac57ec206a60a1bc69b6ca10 Mon Sep 17 00:00:00 2001 From: Jonathan Druart Date: Fri, 22 Jul 2016 08:57:01 +0100 Subject: [PATCH] Bug 16588: Remove Readonly from Edifact Bug 14066 has removed the Readonly dependency, but in the meanwhile, 2 long standing reports reintroduced it: Edifact and ElasticSearch This patchset will remove it from these 2 modules. Test plan: No idea how to test Edifact, I have not tested this patch Signed-off-by: Nick Clemens --- Koha/Edifact/Order.pm | 75 ++++++++++++++++++++++++++------------------------- 1 file changed, 38 insertions(+), 37 deletions(-) diff --git a/Koha/Edifact/Order.pm b/Koha/Edifact/Order.pm index 0381128..1f9a442 100644 --- a/Koha/Edifact/Order.pm +++ b/Koha/Edifact/Order.pm @@ -23,19 +23,20 @@ use utf8; use Carp; use DateTime; -use Readonly; use Business::ISBN; use Koha::Database; use C4::Budgets qw( GetBudget ); -Readonly::Scalar my $seg_terminator => q{'}; -Readonly::Scalar my $separator => q{+}; -Readonly::Scalar my $component_separator => q{:}; -Readonly::Scalar my $release_character => q{?}; +use constant { + SEG_TERMINATOR => q{'}, + SEPARATOR => q{+}, + COMPONENT_SEPARATOR => q{:}, + RELEASE_CHARACTER => q{?}, -Readonly::Scalar my $NINES_12 => 999_999_999_999; -Readonly::Scalar my $NINES_14 => 99_999_999_999_999; -Readonly::Scalar my $CHUNKSIZE => 35; + NINES_12 => 999_999_999_999, + NINES_14 => 99_999_999_999_999, + CHUNKSIZE => 35, +}; sub new { my ( $class, $parameter_hashref ) = @_; @@ -89,7 +90,7 @@ sub filename { sub encode { my ($self) = @_; - $self->{interchange_control_reference} = int rand($NINES_14); + $self->{interchange_control_reference} = int rand(NINES_14); $self->{message_count} = 0; # $self->{segs}; # Message segments @@ -134,24 +135,24 @@ sub interchange_header { $hdr .= _interchange_sr_identifier( $self->{recipient}->san, $self->{recipient}->id_code_qualifier ); # interchange Recipient - $hdr .= $separator; + $hdr .= SEPARATOR; # DateTime of preparation $hdr .= $self->{message_date}->format_cldr('yyMMdd:HHmm'); - $hdr .= $separator; + $hdr .= SEPARATOR; $hdr .= $self->interchange_control_reference(); - $hdr .= $separator; + $hdr .= SEPARATOR; # Recipents reference password not usually used in edifact $hdr .= q{+ORDERS}; # application reference #Edifact does not usually include the following -# $hdr .= $separator; # Processing priority not usually used in edifact -# $hdr .= $separator; # Acknowledgewment request : not usually used in edifact +# $hdr .= SEPARATOR; # Processing priority not usually used in edifact +# $hdr .= SEPARATOR; # Acknowledgewment request : not usually used in edifact # $hdr .= q{+EANCOM} # Communications agreement id # $hdr .= q{+1} # Test indicator # - $hdr .= $seg_terminator; + $hdr .= SEG_TERMINATOR; return $hdr; } @@ -179,19 +180,19 @@ sub message_trailer { my $self = shift; # terminate the message - $self->add_seg("UNS+S$seg_terminator"); + $self->add_seg("UNS+S" . SEG_TERMINATOR); # CNT Control_Total # Could be (code 1) total value of QTY segments # or ( code = 2 ) number of lineitems my $num_orderlines = @{ $self->{orderlines} }; - $self->add_seg("CNT+2:$num_orderlines$seg_terminator"); + $self->add_seg("CNT+2:$num_orderlines" . SEG_TERMINATOR); # UNT Message Trailer my $segments_in_message = 1 + @{ $self->{segs} }; # count incl UNH & UNT (!!this one) my $reference = $self->message_reference('current'); - $self->add_seg("UNT+$segments_in_message+$reference$seg_terminator"); + $self->add_seg("UNT+$segments_in_message+$reference" . SEG_TERMINATOR); return; } @@ -222,7 +223,7 @@ sub message_reference { if ( $function eq 'new' || !$self->{message_reference_no} ) { # unique 14 char mesage ref - $self->{message_reference_no} = sprintf 'ME%012d', int rand($NINES_12); + $self->{message_reference_no} = sprintf 'ME%012d', int rand(NINES_12); } return $self->{message_reference_no}; } @@ -244,7 +245,7 @@ sub interchange_trailer { my $t = "UNZ+$self->{message_count}+"; $t .= $self->interchange_control_reference; - $t .= $seg_terminator; + $t .= SEG_TERMINATOR; return $t; } @@ -310,10 +311,10 @@ sub beginning_of_message { # 22C continuation order for volumes in a set etc. # my $message_code = '220'; if ( exists $bic_sans{$supplier_san} && $response ) { - return "BGM+22V+$document_message_no+9$seg_terminator"; + return "BGM+22V+$document_message_no+9" . SEG_TERMINATOR; } - return "BGM+220+$document_message_no+9$seg_terminator"; + return "BGM+220+$document_message_no+9" . SEG_TERMINATOR; } sub name_and_address { @@ -332,7 +333,7 @@ sub name_and_address { $id_agency = '9'; # ean coded differently in this seg } - return "NAD+$qualifier_code{$party}+${id_code}::$id_agency$seg_terminator"; + return "NAD+$qualifier_code{$party}+${id_code}::$id_agency" . SEG_TERMINATOR; } sub order_line { @@ -367,7 +368,7 @@ sub order_line { $self->add_seg( item_description( $orderline->biblionumber, $biblioitem ) ); # QTY order quantity - my $qty = join q{}, 'QTY+21:', $orderline->quantity, $seg_terminator; + my $qty = join q{}, 'QTY+21:', $orderline->quantity, SEG_TERMINATOR; $self->add_seg($qty); # DTM Optional date constraints on delivery @@ -413,18 +414,18 @@ sub order_line { # Coutts read this as 0.00 if not present if ( $orderline->listprice ) { my $price = sprintf 'PRI+AAE:%.2f:CA', $orderline->listprice; - $price .= $seg_terminator; + $price .= SEG_TERMINATOR; $self->add_seg($price); } # RFF unique orderline reference no - my $rff = join q{}, 'RFF+LI:', $orderline->ordernumber, $seg_terminator; + my $rff = join q{}, 'RFF+LI:', $orderline->ordernumber, SEG_TERMINATOR; $self->add_seg($rff); # RFF : suppliers unique quotation reference number if ( $orderline->suppliers_reference_number ) { $rff = join q{}, 'RFF+', $orderline->suppliers_reference_qualifier, - ':', $orderline->suppliers_reference_number, $seg_terminator; + ':', $orderline->suppliers_reference_number, SEG_TERMINATOR; $self->add_seg($rff); } @@ -481,8 +482,8 @@ sub imd_segment { # chunk_line my @chunks; - while ( my $x = substr $data, 0, $CHUNKSIZE, q{} ) { - if ( length $x == $CHUNKSIZE ) { + while ( my $x = substr $data, 0, CHUNKSIZE, q{} ) { + if ( length $x == CHUNKSIZE ) { if ( $x =~ s/([?]{1,2})$// ) { $data = "$1$data"; # dont breakup ?' ?? etc } @@ -496,12 +497,12 @@ sub imd_segment { push @segs, "$seg_prefix$c"; } else { - $segs[-1] .= ":$c$seg_terminator"; + $segs[-1] .= ":$c" . SEG_TERMINATOR; } $odd = !$odd; } - if ( @segs && $segs[-1] !~ m/$seg_terminator$/o ) { - $segs[-1] .= $seg_terminator; + if ( @segs && $segs[-1] !~ m/SEG_TERMINATOR$/o ) { + $segs[-1] .= SEG_TERMINATOR; } return @segs; } @@ -552,8 +553,8 @@ sub add_gir_identity_number { sub add_seg { my ( $self, @s ) = @_; foreach my $segment (@s) { - if ( $segment !~ m/$seg_terminator$/o ) { - $segment .= $seg_terminator; + if ( $segment !~ m/SEG_TERMINATOR$/o ) { + $segment .= SEG_TERMINATOR; } } push @{ $self->{segs} }, @s; @@ -570,7 +571,7 @@ sub lin_segment { $item_number_id = q||; } - return "LIN+$line_number$item_number_id$seg_terminator"; + return "LIN+$line_number$item_number_id" . SEG_TERMINATOR; } sub additional_product_id { @@ -591,7 +592,7 @@ sub additional_product_id { } # function id set to 5 states this is the main product id - return "PIA+5+$product_id:$product_code$seg_terminator"; + return "PIA+5+$product_id:$product_code" . SEG_TERMINATOR; } sub message_date_segment { @@ -601,7 +602,7 @@ sub message_date_segment { my $message_date = $dt->ymd(q{}); # no sep in edifact format - return "DTM+137:$message_date:102$seg_terminator"; + return "DTM+137:$message_date:102" . SEG_TERMINATOR; } sub _const { -- 2.1.4