Koha/Edifact/Order.pm

   1 package Koha::Edifact::Order;
   2
   3 use strict;
   4 use warnings;
   5 use utf8;
   6
   7 # Copyright 2014,2015 PTFS-Europe Ltd
   8 #
   9 # This file is part of Koha.
  10 #
  11 # Koha is free software; you can redistribute it and/or modify it
  12 # under the terms of the GNU General Public License as published by
  13 # the Free Software Foundation; either version 3 of the License, or
  14 # (at your option) any later version.
  15 #
  16 # Koha is distributed in the hope that it will be useful, but
  17 # WITHOUT ANY WARRANTY; without even the implied warranty of
  18 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  19 # GNU General Public License for more details.
  20 #
  21 # You should have received a copy of the GNU General Public License
  22 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  23
  24 use Carp qw( carp );
  25 use DateTime;
  26 use Readonly qw( Readonly );
  27 use Koha::Database;
  28 use Koha::DateUtils qw( dt_from_string );
  29 use C4::Budgets qw( GetBudget );
  30
  31 use Koha::Acquisition::Orders;
  32
  33 Readonly::Scalar my $seg_terminator      => q{'};
  34 Readonly::Scalar my $separator           => q{+};
  35 Readonly::Scalar my $component_separator => q{:};
  36 Readonly::Scalar my $release_character   => q{?};
  37
  38 Readonly::Scalar my $NINES_12  => 999_999_999_999;
  39 Readonly::Scalar my $NINES_14  => 99_999_999_999_999;
  40 Readonly::Scalar my $CHUNKSIZE => 35;
  41
  42 sub new {
  43     my ( $class, $parameter_hashref ) = @_;
  44
  45     my $self = {};
  46     if ( ref $parameter_hashref ) {
  47         $self->{orderlines}  = $parameter_hashref->{orderlines};
  48         $self->{recipient}   = $parameter_hashref->{vendor};
  49         $self->{sender}      = $parameter_hashref->{ean};
  50         $self->{is_response} = $parameter_hashref->{is_response};
  51
  52         # convenient alias
  53         $self->{basket} = $self->{orderlines}->[0]->basketno;
  54         $self->{message_date} = dt_from_string();
  55     }
  56
  57     # validate that its worth proceeding
  58     if ( !$self->{orderlines} ) {
  59         carp 'No orderlines passed to create order';
  60         return;
  61     }
  62     if ( !$self->{recipient} ) {
  63         carp 'No vendor passed to order creation: basket = '
  64           . $self->{basket}->basketno;
  65         return;
  66     }
  67     if ( !$self->{sender} ) {
  68         carp 'No sender ean passed to order creation: basket = '
  69           . $self->{basket}->basketno;
  70         return;
  71     }
  72
  73     # do this once per object not once per orderline
  74     my $database = Koha::Database->new();
  75     $self->{schema} = $database->schema;
  76
  77     bless $self, $class;
  78     return $self;
  79 }
  80
  81 sub filename {
  82     my $self = shift;
  83     if ( !$self->{orderlines} ) {
  84         return;
  85     }
  86     my $filename = 'ordr' . $self->{basket}->basketno;
  87     $filename .= '.CEP';
  88     return $filename;
  89 }
  90
  91 sub encode {
  92     my ($self) = @_;
  93
  94     $self->{interchange_control_reference} = int rand($NINES_14);
  95     $self->{message_count}                 = 0;
  96
  97     #    $self->{segs}; # Message segments
  98
  99     $self->{transmission} = q{};
 100
 101     $self->{transmission} .= $self->initial_service_segments();
 102
 103     $self->{transmission} .= $self->user_data_message_segments();
 104
 105     $self->{transmission} .= $self->trailing_service_segments();
 106
 107     # Guard against CR LF etc being added in data from DB
 108     $self->{transmission}=~s/[\r\n\t]//g;
 109
 110     return $self->{transmission};
 111 }
 112
 113 sub msg_date_string {
 114     my $self = shift;
 115     return $self->{message_date}->ymd();
 116 }
 117
 118 sub initial_service_segments {
 119     my $self = shift;
 120
 121     #UNA service string advice - specifies standard separators
 122     my $segs = _const('service_string_advice');
 123
 124     #UNB interchange header
 125     $segs .= $self->interchange_header();
 126
 127     #UNG functional group header NOT USED
 128     return $segs;
 129 }
 130
 131 sub interchange_header {
 132     my $self = shift;
 133
 134     # syntax identifier
 135     my $hdr =
 136       'UNB+UNOC:3';    # controlling agency character set syntax version number
 137                        # Interchange Sender
 138     $hdr .= _interchange_sr_identifier( $self->{sender}->ean,
 139         $self->{sender}->id_code_qualifier );    # interchange sender
 140     $hdr .= _interchange_sr_identifier( $self->{recipient}->san,
 141         $self->{recipient}->id_code_qualifier );    # interchange Recipient
 142
 143     $hdr .= $separator;
 144
 145     # DateTime of preparation
 146     $hdr .= $self->{message_date}->format_cldr('yyMMdd:HHmm');
 147     $hdr .= $separator;
 148     $hdr .= $self->interchange_control_reference();
 149     $hdr .= $separator;
 150
 151     # Recipents reference password not usually used in edifact
 152     $hdr .= q{+ORDERS};                             # application reference
 153
 154 #Edifact does not usually include the following
 155 #    $hdr .= $separator; # Processing priority  not usually used in edifact
 156 #    $hdr .= $separator; # Acknowledgewment request : not usually used in edifact
 157 #    $hdr .= q{+EANCOM} # Communications agreement id
 158 #    $hdr .= q{+1} # Test indicator
 159 #
 160     $hdr .= $seg_terminator;
 161     return $hdr;
 162 }
 163
 164 sub user_data_message_segments {
 165     my $self = shift;
 166
 167     #UNH message_header  :: seg count begins here
 168     $self->message_header();
 169
 170     $self->order_msg_header();
 171
 172     my $line_number = 0;
 173     foreach my $ol ( @{ $self->{orderlines} } ) {
 174         ++$line_number;
 175         $self->order_line( $line_number, $ol );
 176     }
 177
 178     $self->message_trailer();
 179
 180     my $data_segment_string = join q{}, @{ $self->{segs} };
 181     return $data_segment_string;
 182 }
 183
 184 sub message_trailer {
 185     my $self = shift;
 186
 187     # terminate the message
 188     $self->add_seg("UNS+S$seg_terminator");
 189
 190     # CNT Control_Total
 191     # Could be (code  1) total value of QTY segments
 192     # or ( code = 2 ) number of lineitems
 193     my $num_orderlines = @{ $self->{orderlines} };
 194     $self->add_seg("CNT+2:$num_orderlines$seg_terminator");
 195
 196     # UNT Message Trailer
 197     my $segments_in_message =
 198       1 + @{ $self->{segs} };    # count incl UNH & UNT (!!this one)
 199     my $reference = $self->message_reference('current');
 200     $self->add_seg("UNT+$segments_in_message+$reference$seg_terminator");
 201     return;
 202 }
 203
 204 sub trailing_service_segments {
 205     my $self    = shift;
 206     my $trailer = q{};
 207
 208     #UNE functional group trailer NOT USED
 209     #UNZ interchange trailer
 210     $trailer .= $self->interchange_trailer();
 211
 212     return $trailer;
 213 }
 214
 215 sub interchange_control_reference {
 216     my $self = shift;
 217     if ( $self->{interchange_control_reference} ) {
 218         return sprintf '%014d', $self->{interchange_control_reference};
 219     }
 220     else {
 221         carp 'calling for ref of unencoded order';
 222         return 'NONE ASSIGNED';
 223     }
 224 }
 225
 226 sub message_reference {
 227     my ( $self, $function ) = @_;
 228     if ( $function eq 'new' || !$self->{message_reference_no} ) {
 229
 230         # unique 14 char mesage ref
 231         $self->{message_reference_no} = sprintf 'ME%012d', int rand($NINES_12);
 232     }
 233     return $self->{message_reference_no};
 234 }
 235
 236 sub message_header {
 237     my $self = shift;
 238
 239     $self->{segs} = [];          # initialize the message
 240     $self->{message_count}++;    # In practice alwaya 1
 241
 242     my $hdr = q{UNH+} . $self->message_reference('new');
 243     $hdr .= _const('message_identifier');
 244     $self->add_seg($hdr);
 245     return;
 246 }
 247
 248 sub interchange_trailer {
 249     my $self = shift;
 250
 251     my $t = "UNZ+$self->{message_count}+";
 252     $t .= $self->interchange_control_reference;
 253     $t .= $seg_terminator;
 254     return $t;
 255 }
 256
 257 sub order_msg_header {
 258     my $self = shift;
 259     my @header;
 260
 261     # UNH  see message_header
 262     # BGM
 263     push @header,
 264       beginning_of_message(
 265         $self->{basket}->basketno,
 266         $self->{recipient}->standard,
 267         $self->{is_response}
 268       );
 269
 270     # DTM
 271     push @header, message_date_segment( $self->{message_date} );
 272
 273     # NAD-RFF buyer supplier ids
 274     push @header,
 275       name_and_address(
 276         'BUYER',
 277         $self->{sender}->ean,
 278         $self->{sender}->id_code_qualifier
 279       );
 280     push @header,
 281       name_and_address(
 282         'SUPPLIER',
 283         $self->{recipient}->san,
 284         $self->{recipient}->id_code_qualifier
 285       );
 286
 287     # repeat for for other relevant parties
 288
 289     # CUX currency
 290     # ISO 4217 code to show default currency prices are quoted in
 291     # e.g. CUX+2:GBP:9'
 292     # TBD currency handling
 293
 294     $self->add_seg(@header);
 295     return;
 296 }
 297
 298 sub beginning_of_message {
 299     my $basketno            = shift;
 300     my $standard            = shift;
 301     my $response            = shift;
 302     my $document_message_no = sprintf '%011d', $basketno;
 303
 304     #    my $message_function = 9;    # original 7 = retransmission
 305     # message_code values
 306     #      220 order
 307     #      224 rush order
 308     #      228 sample order :: order for approval / inspection copies
 309     #      22C continuation  order for volumes in a set etc.
 310     #    my $message_code = '220';
 311
 312     # If the order is in response to a quote and we're dealing with a BIC supplier
 313     my $code = ( $response && ( $standard eq 'BIC' ) ) ? '22V' : '220';
 314     return "BGM+$code+$document_message_no+9$seg_terminator";
 315 }
 316
 317 sub name_and_address {
 318     my ( $party, $id_code, $id_agency ) = @_;
 319     my %qualifier_code = (
 320         BUYER    => 'BY',
 321         DELIVERY => 'DP',    # delivery location if != buyer
 322         INVOICEE => 'IV',    # if different from buyer
 323         SUPPLIER => 'SU',
 324     );
 325     if ( !exists $qualifier_code{$party} ) {
 326         carp "No qualifier code for $party";
 327         return;
 328     }
 329     if ( $id_agency eq '14' ) {
 330         $id_agency = '9';    # ean coded differently in this seg
 331     }
 332
 333     return "NAD+$qualifier_code{$party}+${id_code}::$id_agency$seg_terminator";
 334 }
 335
 336 sub order_line {
 337     my ( $self, $linenumber, $orderline ) = @_;
 338
 339     my $basket = Koha::Acquisition::Orders->find( $orderline->ordernumber )->basket;
 340
 341     my $schema = $self->{schema};
 342     if ( !$orderline->biblionumber )
 343     {                        # cannot generate an orderline without a bib record
 344         return;
 345     }
 346     my $biblionumber = $orderline->biblionumber->biblionumber;
 347     my @biblioitems  = $schema->resultset('Biblioitem')
 348       ->search( { biblionumber => $biblionumber, } );
 349     my $biblioitem = $biblioitems[0];    # makes the assumption there is 1 only
 350                                          # or else all have same details
 351
 352     my $id_string = $orderline->line_item_id;
 353
 354     # LIN line-number in msg :: if we had a 13 digit ean we could add
 355     $self->add_seg( lin_segment( $linenumber, $id_string ) );
 356
 357     # PIA isbn or other id
 358     my @identifiers;
 359     foreach my $id ( $biblioitem->ean, $biblioitem->issn, $biblioitem->isbn ) {
 360         if ( $id && $id ne $id_string ) {
 361             push @identifiers, $id;
 362         }
 363     }
 364     $self->add_seg( additional_product_id( join( ' ', @identifiers ) ) );
 365
 366     #  biblio description
 367     $self->add_seg( item_description( $orderline->biblionumber, $biblioitem ) );
 368
 369     # QTY order quantity
 370     my $qty = join q{}, 'QTY+21:', $orderline->quantity, $seg_terminator;
 371     $self->add_seg($qty);
 372
 373     # DTM Optional date constraints on delivery
 374     #     we dont currently support this in koha
 375     # GIR copy-related data
 376     my $lsq_field = C4::Context->preference('EdifactLSQ');
 377     my @items;
 378     if ( $basket->effective_create_items eq 'ordering' ) {
 379
 380         my @linked_itemnumbers = $orderline->aqorders_items;
 381         foreach my $item (@linked_itemnumbers) {
 382             my $i_obj = $schema->resultset('Item')->find( $item->itemnumber );
 383             if ( defined $i_obj ) {
 384                 push @items, {
 385                     branchcode     => $i_obj->get_column('homebranch'),
 386                     itype          => $i_obj->effective_itemtype,
 387                     $lsq_field     => $i_obj->$lsq_field,
 388                     itemcallnumber => $i_obj->itemcallnumber,
 389                 };
 390             }
 391         }
 392     }
 393     else {
 394         my $item_hash = {
 395             itype          => $biblioitem->itemtype,
 396             itemcallnumber => $biblioitem->cn_class,
 397         };
 398         my $branch = $orderline->basketno->deliveryplace;
 399         if ($branch) {
 400             $item_hash->{branchcode} = $branch;
 401         }
 402         for ( 1 .. $orderline->quantity ) {
 403             push @items, $item_hash;
 404         }
 405     }
 406     my $budget = GetBudget( $orderline->budget_id );
 407     my $ol_fields = { budget_code => $budget->{budget_code}, };
 408
 409     my $item_fields = [];
 410     for my $item (@items) {
 411         push @{$item_fields},
 412           {
 413             branchcode     => $item->{branchcode},
 414             itype          => $item->{itype},
 415             $lsq_field     => $item->{$lsq_field},
 416             itemcallnumber => $item->{itemcallnumber},
 417           };
 418     }
 419     $self->add_seg(
 420         gir_segments(
 421             {
 422                 ol_fields => $ol_fields,
 423                 items     => $item_fields
 424             }
 425         )
 426     );
 427
 428     # TBD what if #items exceeds quantity
 429
 430     # FTX free text for current orderline
 431     #    Pass vendor note in FTX free text segment
 432     if ( $orderline->order_vendornote ) {
 433         my $vendornote = $orderline->order_vendornote;
 434         chomp $vendornote;
 435         my $ftx = 'FTX+LIN+++';
 436         $ftx .= $vendornote;
 437         $ftx .= $seg_terminator;
 438         $self->add_seg($ftx);
 439     }
 440     # Encode notes here
 441     # PRI-CUX-DTM unit price on which order is placed : optional
 442     # Coutts read this as 0.00 if not present
 443     if ( $orderline->listprice ) {
 444         my $price = sprintf 'PRI+AAE:%.2f:CA', $orderline->listprice;
 445         $price .= $seg_terminator;
 446         $self->add_seg($price);
 447     }
 448
 449     # RFF unique orderline reference no
 450     my $rff = join q{}, 'RFF+LI:', $orderline->ordernumber, $seg_terminator;
 451     $self->add_seg($rff);
 452
 453     # RFF : suppliers unique quotation reference number
 454     if ( $orderline->suppliers_reference_number ) {
 455         $rff = join q{}, 'RFF+', $orderline->suppliers_reference_qualifier,
 456           ':', $orderline->suppliers_reference_number, $seg_terminator;
 457         $self->add_seg($rff);
 458     }
 459
 460     # LOC-QTY multiple delivery locations
 461     #TBD to specify extra delivery locs
 462     # NAD order line name and address
 463     #TBD Optionally indicate a name & address or order originator
 464     # TDT method of delivey ol-specific
 465     # TBD requests a special delivery option
 466
 467     return;
 468 }
 469
 470 sub item_description {
 471     my ( $bib, $biblioitem ) = @_;
 472     my $bib_desc = {
 473         author    => $bib->author,
 474         title     => $bib->title,
 475         publisher => $biblioitem->publishercode,
 476         year      => $biblioitem->publicationyear,
 477     };
 478
 479     my @itm = ();
 480
 481     # 009 Author
 482     # 050 Title   :: title
 483     # 080 Vol/Part no
 484     # 100 Edition statement
 485     # 109 Publisher  :: publisher
 486     # 110 place of pub
 487     # 170 Date of publication :: year
 488     # 220 Binding  :: binding
 489     my %code = (
 490         author    => '009',
 491         title     => '050',
 492         publisher => '109',
 493         year      => '170',
 494         binding   => '220',
 495     );
 496     for my $field (qw(author title publisher year binding )) {
 497         if ( $bib_desc->{$field} ) {
 498             my $data = encode_text( $bib_desc->{$field} );
 499             push @itm, imd_segment( $code{$field}, $data );
 500         }
 501     }
 502
 503     return @itm;
 504 }
 505
 506 sub imd_segment {
 507     my ( $code, $data ) = @_;
 508
 509     my $seg_prefix = "IMD+L+$code+:::";
 510
 511     # chunk_line
 512     my @chunks;
 513     while ( my $x = substr $data, 0, $CHUNKSIZE, q{} ) {
 514         if ( length $x == $CHUNKSIZE ) {
 515             if ( $x =~ s/([?]{1,2})$// ) {
 516                 $data = "$1$data";    # dont breakup ?' ?? etc
 517             }
 518         }
 519         push @chunks, $x;
 520     }
 521     my @segs;
 522     my $odd = 1;
 523     foreach my $c (@chunks) {
 524         if ($odd) {
 525             push @segs, "$seg_prefix$c";
 526         }
 527         else {
 528             $segs[-1] .= ":$c$seg_terminator";
 529         }
 530         $odd = !$odd;
 531     }
 532     if ( @segs && $segs[-1] !~ m/[^?]$seg_terminator$/o ) {
 533         $segs[-1] .= $seg_terminator;
 534     }
 535     return @segs;
 536 }
 537
 538 sub gir_segments {
 539     my ($params) = @_;
 540
 541     my $orderfields  = $params->{ol_fields};
 542     my @onorderitems = @{ $params->{items} };
 543
 544     my $budget_code = $orderfields->{budget_code};
 545     my @segments;
 546     my $sequence_no = 1;
 547     my $lsq_field = C4::Context->preference('EdifactLSQ');
 548     foreach my $item (@onorderitems) {
 549         my $elements_added = 0;
 550         my @gir_elements;
 551         if ($budget_code) {
 552             push @gir_elements,
 553               { identity_number => 'LFN', data => $budget_code };
 554         }
 555         if ( $item->{branchcode} ) {
 556             push @gir_elements,
 557               { identity_number => 'LLO', data => $item->{branchcode} };
 558         }
 559         if ( $item->{itype} ) {
 560             push @gir_elements,
 561               { identity_number => 'LST', data => $item->{itype} };
 562         }
 563         if ( $item->{$lsq_field} ) {
 564             push @gir_elements,
 565               { identity_number => 'LSQ', data => $item->{$lsq_field} };
 566         }
 567         if ( $item->{itemcallnumber} ) {
 568             push @gir_elements,
 569               { identity_number => 'LSM', data => $item->{itemcallnumber} };
 570         }
 571
 572         # itemcallnumber -> shelfmark
 573         if ( $orderfields->{servicing_instruction} ) {
 574             push @gir_elements,
 575               {
 576                 identity_number => 'LVT',
 577                 data            => $orderfields->{servicing_instruction}
 578               };
 579         }
 580         my $e_cnt = 0;    # count number of elements so we dont exceed 5 per segment
 581         my $copy_no = sprintf 'GIR+%03d', $sequence_no;
 582         my $seg     = $copy_no;
 583         foreach my $e (@gir_elements) {
 584             if ( $e_cnt == 5 ) {
 585                 push @segments, $seg;
 586                 $seg = $copy_no;
 587             }
 588             $seg .=
 589               add_gir_identity_number( $e->{identity_number}, $e->{data} );
 590             ++$e_cnt;
 591         }
 592
 593         $sequence_no++;
 594         push @segments, $seg;
 595     }
 596     return @segments;
 597 }
 598
 599 sub add_gir_identity_number {
 600     my ( $number_qualifier, $number ) = @_;
 601     if ($number) {
 602         return "+${number}:${number_qualifier}";
 603     }
 604     return q{};
 605 }
 606
 607 sub add_seg {
 608     my ( $self, @s ) = @_;
 609     foreach my $segment (@s) {
 610         if ( $segment !~ m/$seg_terminator$/o ) {
 611             $segment .= $seg_terminator;
 612         }
 613     }
 614     push @{ $self->{segs} }, @s;
 615     return;
 616 }
 617
 618 sub lin_segment {
 619     my ( $line_number, $item_number_id ) = @_;
 620
 621     if ($item_number_id) {
 622         $item_number_id = "++${item_number_id}:EN";
 623     }
 624     else {
 625         $item_number_id = q||;
 626     }
 627
 628     return "LIN+$line_number$item_number_id$seg_terminator";
 629 }
 630
 631 sub additional_product_id {
 632     my $isbn_field = shift;
 633     my ( $product_id, $product_code );
 634     if ( $isbn_field =~ m/(\d{13})/ ) {
 635         $product_id   = $1;
 636         $product_code = 'EN';
 637     }
 638     elsif ( $isbn_field =~ m/(\d{9}[Xx\d])/ ) {
 639         $product_id   = $1;
 640         $product_code = 'IB';
 641     }
 642
 643     # TBD we could have a manufacturers no issn etc
 644     if ( !$product_id ) {
 645         return;
 646     }
 647
 648     # function id set to 5 states this is the main product id
 649     return "PIA+5+$product_id:$product_code$seg_terminator";
 650 }
 651
 652 sub message_date_segment {
 653     my $dt = shift;
 654
 655     # qualifier:message_date:format_code
 656
 657     my $message_date = $dt->ymd(q{});    # no sep in edifact format
 658
 659     return "DTM+137:$message_date:102$seg_terminator";
 660 }
 661
 662 sub _const {
 663     my $key = shift;
 664     Readonly my %S => {
 665         service_string_advice => q{UNA:+.? '},
 666         message_identifier    => q{+ORDERS:D:96A:UN:EAN008'},
 667     };
 668     return ( $S{$key} ) ? $S{$key} : q{};
 669 }
 670
 671 sub _interchange_sr_identifier {
 672     my ( $identification, $qualifier ) = @_;
 673
 674     if ( !$identification ) {
 675         $identification = 'RANDOM';
 676         $qualifier      = '92';
 677         carp 'undefined identifier';
 678     }
 679
 680     # 14   EAN International
 681     # 31B   US SAN (preferred)
 682     # also 91 assigned by supplier
 683     # also 92 assigned by buyer
 684     if ( $qualifier !~ m/^(?:14|31B|91|92)/xms ) {
 685         $qualifier = '92';
 686     }
 687
 688     return "+$identification:$qualifier";
 689 }
 690
 691 sub encode_text {
 692     my $string = shift;
 693     if ($string) {
 694         $string =~ s/[?]/??/g;
 695         $string =~ s/'/?'/g;
 696         $string =~ s/:/?:/g;
 697         $string =~ s/[+]/?+/g;
 698     }
 699     return $string;
 700 }
 701
 702 1;
 703 __END__
 704
 705 =head1 NAME
 706
 707 Koha::Edifact::Order
 708
 709 =head1 SYNOPSIS
 710
 711 Format an Edifact Order message from a Koha basket
 712
 713 =head1 DESCRIPTION
 714
 715 Generates an Edifact format Order message for a Koha basket.
 716 Normally the only methods used directly by the caller would be
 717 new to set up the message, encode to return the formatted message
 718 and filename to obtain a name under which to store the message
 719
 720 =head1 BUGS
 721
 722 Should integrate into Koha::Edifact namespace
 723 Can caller interface be made cleaner?
 724 Make handling of GIR segments more customizable
 725
 726 =head1 METHODS
 727
 728 =head2 new
 729
 730   my $edi_order = Edifact::Order->new(
 731   orderlines => \@orderlines,
 732   vendor     => $vendor_edi_account,
 733   ean        => $library_ean
 734   );
 735
 736   instantiate the Edifact::Order object, all parameters are Schema::Resultset objects
 737   Called in Koha::Edifact create_edi_order
 738
 739 =head2 filename
 740
 741    my $filename = $edi_order->filename()
 742
 743    returns a filename for the edi order. The filename embeds a reference to the
 744    basket the message was created to encode
 745
 746 =head2 encode
 747
 748    my $edifact_message = $edi_order->encode();
 749
 750    Encodes the basket as a valid edifact message ready for transmission
 751
 752 =head2 initial_service_segments
 753
 754     Creates the service segments which begin the message
 755
 756 =head2 interchange_header
 757
 758     Return an interchange header encoding sender and recipient
 759     ids message date and standards
 760
 761 =head2 user_data_message_segments
 762
 763     Include message data within the encoded message
 764
 765 =head2 message_trailer
 766
 767     Terminate message data including control data on number
 768     of messages and segments included
 769
 770 =head2 trailing_service_segments
 771
 772    Include the service segments occurring at the end of the message
 773
 774 =head2 interchange_control_reference
 775
 776    Returns the unique interchange control reference as a 14 digit number
 777
 778 =head2 message_reference
 779
 780     On generates and subsequently returns the unique message
 781     reference number as a 12 digit number preceded by ME, to generate a new number
 782     pass the string 'new'.
 783     In practice we encode 1 message per transmission so there is only one message
 784     referenced. were we to encode multiple messages a new reference would be
 785     neaded for each
 786
 787 =head2 message_header
 788
 789     Commences a new message
 790
 791 =head2 interchange_trailer
 792
 793     returns the UNZ segment which ends the tranmission encoding the
 794     message count and control reference for the interchange
 795
 796 =head2 order_msg_header
 797
 798     Formats the message header segments
 799
 800 =head2 beginning_of_message
 801
 802     Returns the BGM segment which includes the Koha basket number
 803
 804 =head2 name_and_address
 805
 806     Parameters: Function ( BUYER, DELIVERY, INVOICE, SUPPLIER)
 807                 Id
 808                 Agency
 809
 810     Returns a NAD segment containg the id and agency for for the Function
 811     value. Handles the fact that NAD segments encode the value for 'EAN' differently
 812     to elsewhere.
 813
 814 =head2 order_line
 815
 816     Creates the message segments wncoding an order line
 817
 818 =head2 item_description
 819
 820     Encodes the biblio item fields Author, title, publisher, date of publication
 821     binding
 822
 823 =head2 imd_segment
 824
 825     Formats an IMD segment, handles the chunking of data into the 35 character
 826     lengths required and the creation of repeat segments
 827
 828 =head2 gir_segments
 829
 830     Add item level information
 831
 832 =head2 add_gir_identity_number
 833
 834     Handle the formatting of a GIR element
 835     return empty string if no data
 836
 837 =head2 add_seg
 838
 839     Adds a parssed array of segments to the objects segment list
 840     ensures all segments are properly terminated by '
 841
 842 =head2 lin_segment
 843
 844     Adds a LIN segment consisting of the line number and the ean number
 845     if the passed isbn is valid
 846
 847 =head2 additional_product_id
 848
 849     Add a PIA segment for an additional product id
 850
 851 =head2 message_date_segment
 852
 853     Passed a DateTime object returns a correctly formatted DTM segment
 854
 855 =head2 _const
 856
 857     Stores and returns constant strings for service_string_advice
 858     and message_identifier
 859     TBD replace with class variables
 860
 861 =head2 _interchange_sr_identifier
 862
 863     Format sender and receipient identifiers for use in the interchange header
 864
 865 =head2 encode_text
 866
 867     Encode textual data into the standard character set ( iso 8859-1 )
 868     and quote any Edifact metacharacters
 869
 870 =head2 msg_date_string
 871
 872     Convenient routine which returns message date as a Y-m-d string
 873     useful if the caller wants to log date of creation
 874
 875 =head1 AUTHOR
 876
 877    Colin Campbell <colin.campbell@ptfs-europe.com>
 878
 879
 880 =head1 COPYRIGHT
 881
 882    Copyright 2014,2015,2016 PTFS-Europe Ltd
 883    This program is free software, You may redistribute it under
 884    under the terms of the GNU General Public License
 885
 886
 887 =cut