View | Details | Raw Unified | Return to bug 16588
Collapse All | Expand All

(-)a/Koha/Edifact/Order.pm (-38 / +38 lines)
Lines 23-41 use utf8; Link Here
23
23
24
use Carp;
24
use Carp;
25
use DateTime;
25
use DateTime;
26
use Readonly;
27
use Business::ISBN;
26
use Business::ISBN;
28
use Koha::Database;
27
use Koha::Database;
29
use C4::Budgets qw( GetBudget );
28
use C4::Budgets qw( GetBudget );
30
29
31
Readonly::Scalar my $seg_terminator      => q{'};
30
use constant {
32
Readonly::Scalar my $separator           => q{+};
31
    SEG_TERMINATOR      => q{'},
33
Readonly::Scalar my $component_separator => q{:};
32
    SEPARATOR           => q{+},
34
Readonly::Scalar my $release_character   => q{?};
33
    COMPONENT_SEPARATOR => q{:},
34
    RELEASE_CHARACTER   => q{?},
35
35
36
Readonly::Scalar my $NINES_12  => 999_999_999_999;
36
    NINES_12  => 999_999_999_999,
37
Readonly::Scalar my $NINES_14  => 99_999_999_999_999;
37
    NINES_14  => 99_999_999_999_999,
38
Readonly::Scalar my $CHUNKSIZE => 35;
38
    CHUNKSIZE => 35,
39
};
39
40
40
sub new {
41
sub new {
41
    my ( $class, $parameter_hashref ) = @_;
42
    my ( $class, $parameter_hashref ) = @_;
Lines 89-95 sub filename { Link Here
89
sub encode {
90
sub encode {
90
    my ($self) = @_;
91
    my ($self) = @_;
91
92
92
    $self->{interchange_control_reference} = int rand($NINES_14);
93
    $self->{interchange_control_reference} = int rand(NINES_14);
93
    $self->{message_count}                 = 0;
94
    $self->{message_count}                 = 0;
94
95
95
    #    $self->{segs}; # Message segments
96
    #    $self->{segs}; # Message segments
Lines 134-157 sub interchange_header { Link Here
134
    $hdr .= _interchange_sr_identifier( $self->{recipient}->san,
135
    $hdr .= _interchange_sr_identifier( $self->{recipient}->san,
135
        $self->{recipient}->id_code_qualifier );    # interchange Recipient
136
        $self->{recipient}->id_code_qualifier );    # interchange Recipient
136
137
137
    $hdr .= $separator;
138
    $hdr .= SEPARATOR;
138
139
139
    # DateTime of preparation
140
    # DateTime of preparation
140
    $hdr .= $self->{message_date}->format_cldr('yyMMdd:HHmm');
141
    $hdr .= $self->{message_date}->format_cldr('yyMMdd:HHmm');
141
    $hdr .= $separator;
142
    $hdr .= SEPARATOR;
142
    $hdr .= $self->interchange_control_reference();
143
    $hdr .= $self->interchange_control_reference();
143
    $hdr .= $separator;
144
    $hdr .= SEPARATOR;
144
145
145
    # Recipents reference password not usually used in edifact
146
    # Recipents reference password not usually used in edifact
146
    $hdr .= q{+ORDERS};                             # application reference
147
    $hdr .= q{+ORDERS};                             # application reference
147
148
148
#Edifact does not usually include the following
149
#Edifact does not usually include the following
149
#    $hdr .= $separator; # Processing priority  not usually used in edifact
150
#    $hdr .= SEPARATOR; # Processing priority  not usually used in edifact
150
#    $hdr .= $separator; # Acknowledgewment request : not usually used in edifact
151
#    $hdr .= SEPARATOR; # Acknowledgewment request : not usually used in edifact
151
#    $hdr .= q{+EANCOM} # Communications agreement id
152
#    $hdr .= q{+EANCOM} # Communications agreement id
152
#    $hdr .= q{+1} # Test indicator
153
#    $hdr .= q{+1} # Test indicator
153
#
154
#
154
    $hdr .= $seg_terminator;
155
    $hdr .= SEG_TERMINATOR;
155
    return $hdr;
156
    return $hdr;
156
}
157
}
157
158
Lines 179-197 sub message_trailer { Link Here
179
    my $self = shift;
180
    my $self = shift;
180
181
181
    # terminate the message
182
    # terminate the message
182
    $self->add_seg("UNS+S$seg_terminator");
183
    $self->add_seg("UNS+S" . SEG_TERMINATOR);
183
184
184
    # CNT Control_Total
185
    # CNT Control_Total
185
    # Could be (code  1) total value of QTY segments
186
    # Could be (code  1) total value of QTY segments
186
    # or ( code = 2 ) number of lineitems
187
    # or ( code = 2 ) number of lineitems
187
    my $num_orderlines = @{ $self->{orderlines} };
188
    my $num_orderlines = @{ $self->{orderlines} };
188
    $self->add_seg("CNT+2:$num_orderlines$seg_terminator");
189
    $self->add_seg("CNT+2:$num_orderlines" . SEG_TERMINATOR);
189
190
190
    # UNT Message Trailer
191
    # UNT Message Trailer
191
    my $segments_in_message =
192
    my $segments_in_message =
192
      1 + @{ $self->{segs} };    # count incl UNH & UNT (!!this one)
193
      1 + @{ $self->{segs} };    # count incl UNH & UNT (!!this one)
193
    my $reference = $self->message_reference('current');
194
    my $reference = $self->message_reference('current');
194
    $self->add_seg("UNT+$segments_in_message+$reference$seg_terminator");
195
    $self->add_seg("UNT+$segments_in_message+$reference" . SEG_TERMINATOR);
195
    return;
196
    return;
196
}
197
}
197
198
Lines 222-228 sub message_reference { Link Here
222
    if ( $function eq 'new' || !$self->{message_reference_no} ) {
223
    if ( $function eq 'new' || !$self->{message_reference_no} ) {
223
224
224
        # unique 14 char mesage ref
225
        # unique 14 char mesage ref
225
        $self->{message_reference_no} = sprintf 'ME%012d', int rand($NINES_12);
226
        $self->{message_reference_no} = sprintf 'ME%012d', int rand(NINES_12);
226
    }
227
    }
227
    return $self->{message_reference_no};
228
    return $self->{message_reference_no};
228
}
229
}
Lines 244-250 sub interchange_trailer { Link Here
244
245
245
    my $t = "UNZ+$self->{message_count}+";
246
    my $t = "UNZ+$self->{message_count}+";
246
    $t .= $self->interchange_control_reference;
247
    $t .= $self->interchange_control_reference;
247
    $t .= $seg_terminator;
248
    $t .= SEG_TERMINATOR;
248
    return $t;
249
    return $t;
249
}
250
}
250
251
Lines 310-319 sub beginning_of_message { Link Here
310
    #      22C continuation  order for volumes in a set etc.
311
    #      22C continuation  order for volumes in a set etc.
311
    #    my $message_code = '220';
312
    #    my $message_code = '220';
312
    if ( exists $bic_sans{$supplier_san} && $response ) {
313
    if ( exists $bic_sans{$supplier_san} && $response ) {
313
        return "BGM+22V+$document_message_no+9$seg_terminator";
314
        return "BGM+22V+$document_message_no+9" . SEG_TERMINATOR;
314
    }
315
    }
315
316
316
    return "BGM+220+$document_message_no+9$seg_terminator";
317
    return "BGM+220+$document_message_no+9" . SEG_TERMINATOR;
317
}
318
}
318
319
319
sub name_and_address {
320
sub name_and_address {
Lines 332-338 sub name_and_address { Link Here
332
        $id_agency = '9';    # ean coded differently in this seg
333
        $id_agency = '9';    # ean coded differently in this seg
333
    }
334
    }
334
335
335
    return "NAD+$qualifier_code{$party}+${id_code}::$id_agency$seg_terminator";
336
    return "NAD+$qualifier_code{$party}+${id_code}::$id_agency" . SEG_TERMINATOR;
336
}
337
}
337
338
338
sub order_line {
339
sub order_line {
Lines 367-373 sub order_line { Link Here
367
    $self->add_seg( item_description( $orderline->biblionumber, $biblioitem ) );
368
    $self->add_seg( item_description( $orderline->biblionumber, $biblioitem ) );
368
369
369
    # QTY order quantity
370
    # QTY order quantity
370
    my $qty = join q{}, 'QTY+21:', $orderline->quantity, $seg_terminator;
371
    my $qty = join q{}, 'QTY+21:', $orderline->quantity, SEG_TERMINATOR;
371
    $self->add_seg($qty);
372
    $self->add_seg($qty);
372
373
373
    # DTM Optional date constraints on delivery
374
    # DTM Optional date constraints on delivery
Lines 413-430 sub order_line { Link Here
413
    # Coutts read this as 0.00 if not present
414
    # Coutts read this as 0.00 if not present
414
    if ( $orderline->listprice ) {
415
    if ( $orderline->listprice ) {
415
        my $price = sprintf 'PRI+AAE:%.2f:CA', $orderline->listprice;
416
        my $price = sprintf 'PRI+AAE:%.2f:CA', $orderline->listprice;
416
        $price .= $seg_terminator;
417
        $price .= SEG_TERMINATOR;
417
        $self->add_seg($price);
418
        $self->add_seg($price);
418
    }
419
    }
419
420
420
    # RFF unique orderline reference no
421
    # RFF unique orderline reference no
421
    my $rff = join q{}, 'RFF+LI:', $orderline->ordernumber, $seg_terminator;
422
    my $rff = join q{}, 'RFF+LI:', $orderline->ordernumber, SEG_TERMINATOR;
422
    $self->add_seg($rff);
423
    $self->add_seg($rff);
423
424
424
    # RFF : suppliers unique quotation reference number
425
    # RFF : suppliers unique quotation reference number
425
    if ( $orderline->suppliers_reference_number ) {
426
    if ( $orderline->suppliers_reference_number ) {
426
        $rff = join q{}, 'RFF+', $orderline->suppliers_reference_qualifier,
427
        $rff = join q{}, 'RFF+', $orderline->suppliers_reference_qualifier,
427
          ':', $orderline->suppliers_reference_number, $seg_terminator;
428
          ':', $orderline->suppliers_reference_number, SEG_TERMINATOR;
428
        $self->add_seg($rff);
429
        $self->add_seg($rff);
429
    }
430
    }
430
431
Lines 481-488 sub imd_segment { Link Here
481
482
482
    # chunk_line
483
    # chunk_line
483
    my @chunks;
484
    my @chunks;
484
    while ( my $x = substr $data, 0, $CHUNKSIZE, q{} ) {
485
    while ( my $x = substr $data, 0, CHUNKSIZE, q{} ) {
485
        if ( length $x == $CHUNKSIZE ) {
486
        if ( length $x == CHUNKSIZE ) {
486
            if ( $x =~ s/([?]{1,2})$// ) {
487
            if ( $x =~ s/([?]{1,2})$// ) {
487
                $data = "$1$data";    # dont breakup ?' ?? etc
488
                $data = "$1$data";    # dont breakup ?' ?? etc
488
            }
489
            }
Lines 496-507 sub imd_segment { Link Here
496
            push @segs, "$seg_prefix$c";
497
            push @segs, "$seg_prefix$c";
497
        }
498
        }
498
        else {
499
        else {
499
            $segs[-1] .= ":$c$seg_terminator";
500
            $segs[-1] .= ":$c" . SEG_TERMINATOR;
500
        }
501
        }
501
        $odd = !$odd;
502
        $odd = !$odd;
502
    }
503
    }
503
    if ( @segs && $segs[-1] !~ m/$seg_terminator$/o ) {
504
    if ( @segs && $segs[-1] !~ m/SEG_TERMINATOR$/o ) {
504
        $segs[-1] .= $seg_terminator;
505
        $segs[-1] .= SEG_TERMINATOR;
505
    }
506
    }
506
    return @segs;
507
    return @segs;
507
}
508
}
Lines 552-559 sub add_gir_identity_number { Link Here
552
sub add_seg {
553
sub add_seg {
553
    my ( $self, @s ) = @_;
554
    my ( $self, @s ) = @_;
554
    foreach my $segment (@s) {
555
    foreach my $segment (@s) {
555
        if ( $segment !~ m/$seg_terminator$/o ) {
556
        if ( $segment !~ m/SEG_TERMINATOR$/o ) {
556
            $segment .= $seg_terminator;
557
            $segment .= SEG_TERMINATOR;
557
        }
558
        }
558
    }
559
    }
559
    push @{ $self->{segs} }, @s;
560
    push @{ $self->{segs} }, @s;
Lines 570-576 sub lin_segment { Link Here
570
        $item_number_id = q||;
571
        $item_number_id = q||;
571
    }
572
    }
572
573
573
    return "LIN+$line_number$item_number_id$seg_terminator";
574
    return "LIN+$line_number$item_number_id" . SEG_TERMINATOR;
574
}
575
}
575
576
576
sub additional_product_id {
577
sub additional_product_id {
Lines 591-597 sub additional_product_id { Link Here
591
    }
592
    }
592
593
593
    # function id set to 5 states this is the main product id
594
    # function id set to 5 states this is the main product id
594
    return "PIA+5+$product_id:$product_code$seg_terminator";
595
    return "PIA+5+$product_id:$product_code" . SEG_TERMINATOR;
595
}
596
}
596
597
597
sub message_date_segment {
598
sub message_date_segment {
Lines 601-607 sub message_date_segment { Link Here
601
602
602
    my $message_date = $dt->ymd(q{});    # no sep in edifact format
603
    my $message_date = $dt->ymd(q{});    # no sep in edifact format
603
604
604
    return "DTM+137:$message_date:102$seg_terminator";
605
    return "DTM+137:$message_date:102" . SEG_TERMINATOR;
605
}
606
}
606
607
607
sub _const {
608
sub _const {
608
- 

Return to bug 16588