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 @items;
 377     if ( $basket->effective_create_items eq 'ordering' ) {
 378         my @linked_itemnumbers = $orderline->aqorders_items;
 379
 380         foreach my $item (@linked_itemnumbers) {
 381             my $i_obj = $schema->resultset('Item')->find( $item->itemnumber );
 382             if ( defined $i_obj ) {
 383                 push @items, {
 384                     branchcode     => $i_obj->get_column('homebranch'),
 385                     itype          => $i_obj->effective_itemtype,
 386                     location       => $i_obj->location,
 387                     itemcallnumber => $i_obj->itemcallnumber,
 388                 };
 389             }
 390         }
 391     }
 392     else {
 393         my $item_hash = {
 394             itype          => $biblioitem->itemtype,
 395             itemcallnumber => $biblioitem->cn_class,
 396         };
 397         my $branch = $orderline->basketno->deliveryplace;
 398         if ($branch) {
 399             $item_hash->{branchcode} = $branch;
 400         }
 401         for ( 1 .. $orderline->quantity ) {
 402             push @items, $item_hash;
 403         }
 404     }
 405     my $budget = GetBudget( $orderline->budget_id );
 406     my $ol_fields = { budget_code => $budget->{budget_code}, };
 407
 408     my $item_fields = [];
 409     for my $item (@items) {
 410         push @{$item_fields},
 411           {
 412             branchcode     => $item->{branchcode},
 413             itype          => $item->{itype},
 414             location       => $item->{location},
 415             itemcallnumber => $item->{itemcallnumber},
 416           };
 417     }
 418     $self->add_seg(
 419         gir_segments(
 420             {
 421                 ol_fields => $ol_fields,
 422                 items     => $item_fields
 423             }
 424         )
 425     );
 426
 427     # TBD what if #items exceeds quantity
 428
 429     # FTX free text for current orderline
 430     #    Pass vendor note in FTX free text segment
 431     if ( $orderline->order_vendornote ) {
 432         my $vendornote = $orderline->order_vendornote;
 433         chomp $vendornote;
 434         my $ftx = 'FTX+LIN+++';
 435         $ftx .= $vendornote;
 436         $ftx .= $seg_terminator;
 437         $self->add_seg($ftx);
 438     }
 439     # Encode notes here
 440     # PRI-CUX-DTM unit price on which order is placed : optional
 441     # Coutts read this as 0.00 if not present
 442     if ( $orderline->listprice ) {
 443         my $price = sprintf 'PRI+AAE:%.2f:CA', $orderline->listprice;
 444         $price .= $seg_terminator;
 445         $self->add_seg($price);
 446     }
 447
 448     # RFF unique orderline reference no
 449     my $rff = join q{}, 'RFF+LI:', $orderline->ordernumber, $seg_terminator;
 450     $self->add_seg($rff);
 451
 452     # RFF : suppliers unique quotation reference number
 453     if ( $orderline->suppliers_reference_number ) {
 454         $rff = join q{}, 'RFF+', $orderline->suppliers_reference_qualifier,
 455           ':', $orderline->suppliers_reference_number, $seg_terminator;
 456         $self->add_seg($rff);
 457     }
 458
 459     # LOC-QTY multiple delivery locations
 460     #TBD to specify extra delivery locs
 461     # NAD order line name and address
 462     #TBD Optionally indicate a name & address or order originator
 463     # TDT method of delivey ol-specific
 464     # TBD requests a special delivery option
 465
 466     return;
 467 }
 468
 469 sub item_description {
 470     my ( $bib, $biblioitem ) = @_;
 471     my $bib_desc = {
 472         author    => $bib->author,
 473         title     => $bib->title,
 474         publisher => $biblioitem->publishercode,
 475         year      => $biblioitem->publicationyear,
 476     };
 477
 478     my @itm = ();
 479
 480     # 009 Author
 481     # 050 Title   :: title
 482     # 080 Vol/Part no
 483     # 100 Edition statement
 484     # 109 Publisher  :: publisher
 485     # 110 place of pub
 486     # 170 Date of publication :: year
 487     # 220 Binding  :: binding
 488     my %code = (
 489         author    => '009',
 490         title     => '050',
 491         publisher => '109',
 492         year      => '170',
 493         binding   => '220',
 494     );
 495     for my $field (qw(author title publisher year binding )) {
 496         if ( $bib_desc->{$field} ) {
 497             my $data = encode_text( $bib_desc->{$field} );
 498             push @itm, imd_segment( $code{$field}, $data );
 499         }
 500     }
 501
 502     return @itm;
 503 }
 504
 505 sub imd_segment {
 506     my ( $code, $data ) = @_;
 507
 508     my $seg_prefix = "IMD+L+$code+:::";
 509
 510     # chunk_line
 511     my @chunks;
 512     while ( my $x = substr $data, 0, $CHUNKSIZE, q{} ) {
 513         if ( length $x == $CHUNKSIZE ) {
 514             if ( $x =~ s/([?]{1,2})$// ) {
 515                 $data = "$1$data";    # dont breakup ?' ?? etc
 516             }
 517         }
 518         push @chunks, $x;
 519     }
 520     my @segs;
 521     my $odd = 1;
 522     foreach my $c (@chunks) {
 523         if ($odd) {
 524             push @segs, "$seg_prefix$c";
 525         }
 526         else {
 527             $segs[-1] .= ":$c$seg_terminator";
 528         }
 529         $odd = !$odd;
 530     }
 531     if ( @segs && $segs[-1] !~ m/[^?]$seg_terminator$/o ) {
 532         $segs[-1] .= $seg_terminator;
 533     }
 534     return @segs;
 535 }
 536
 537 sub gir_segments {
 538     my ($params) = @_;
 539
 540     my $orderfields  = $params->{ol_fields};
 541     my @onorderitems = @{ $params->{items} };
 542
 543     my $budget_code = $orderfields->{budget_code};
 544     my @segments;
 545     my $sequence_no = 1;
 546     foreach my $item (@onorderitems) {
 547         my $elements_added = 0;
 548         my @gir_elements;
 549         if ($budget_code) {
 550             push @gir_elements,
 551               { identity_number => 'LFN', data => $budget_code };
 552         }
 553         if ( $item->{branchcode} ) {
 554             push @gir_elements,
 555               { identity_number => 'LLO', data => $item->{branchcode} };
 556         }
 557         if ( $item->{itype} ) {
 558             push @gir_elements,
 559               { identity_number => 'LST', data => $item->{itype} };
 560         }
 561         if ( $item->{location} ) {
 562             push @gir_elements,
 563               { identity_number => 'LSQ', data => $item->{location} };
 564         }
 565         if ( $item->{itemcallnumber} ) {
 566             push @gir_elements,
 567               { identity_number => 'LSM', data => $item->{itemcallnumber} };
 568         }
 569
 570         # itemcallnumber -> shelfmark
 571         if ( $orderfields->{servicing_instruction} ) {
 572             push @gir_elements,
 573               {
 574                 identity_number => 'LVT',
 575                 data            => $orderfields->{servicing_instruction}
 576               };
 577         }
 578         my $e_cnt = 0;    # count number of elements so we dont exceed 5 per segment
 579         my $copy_no = sprintf 'GIR+%03d', $sequence_no;
 580         my $seg     = $copy_no;
 581         foreach my $e (@gir_elements) {
 582             if ( $e_cnt == 5 ) {
 583                 push @segments, $seg;
 584                 $seg = $copy_no;
 585             }
 586             $seg .=
 587               add_gir_identity_number( $e->{identity_number}, $e->{data} );
 588             ++$e_cnt;
 589         }
 590
 591         $sequence_no++;
 592         push @segments, $seg;
 593     }
 594     return @segments;
 595 }
 596
 597 sub add_gir_identity_number {
 598     my ( $number_qualifier, $number ) = @_;
 599     if ($number) {
 600         return "+${number}:${number_qualifier}";
 601     }
 602     return q{};
 603 }
 604
 605 sub add_seg {
 606     my ( $self, @s ) = @_;
 607     foreach my $segment (@s) {
 608         if ( $segment !~ m/$seg_terminator$/o ) {
 609             $segment .= $seg_terminator;
 610         }
 611     }
 612     push @{ $self->{segs} }, @s;
 613     return;
 614 }
 615
 616 sub lin_segment {
 617     my ( $line_number, $item_number_id ) = @_;
 618
 619     if ($item_number_id) {
 620         $item_number_id = "++${item_number_id}:EN";
 621     }
 622     else {
 623         $item_number_id = q||;
 624     }
 625
 626     return "LIN+$line_number$item_number_id$seg_terminator";
 627 }
 628
 629 sub additional_product_id {
 630     my $isbn_field = shift;
 631     my ( $product_id, $product_code );
 632     if ( $isbn_field =~ m/(\d{13})/ ) {
 633         $product_id   = $1;
 634         $product_code = 'EN';
 635     }
 636     elsif ( $isbn_field =~ m/(\d{9}[Xx\d])/ ) {
 637         $product_id   = $1;
 638         $product_code = 'IB';
 639     }
 640
 641     # TBD we could have a manufacturers no issn etc
 642     if ( !$product_id ) {
 643         return;
 644     }
 645
 646     # function id set to 5 states this is the main product id
 647     return "PIA+5+$product_id:$product_code$seg_terminator";
 648 }
 649
 650 sub message_date_segment {
 651     my $dt = shift;
 652
 653     # qualifier:message_date:format_code
 654
 655     my $message_date = $dt->ymd(q{});    # no sep in edifact format
 656
 657     return "DTM+137:$message_date:102$seg_terminator";
 658 }
 659
 660 sub _const {
 661     my $key = shift;
 662     Readonly my %S => {
 663         service_string_advice => q{UNA:+.? '},
 664         message_identifier    => q{+ORDERS:D:96A:UN:EAN008'},
 665     };
 666     return ( $S{$key} ) ? $S{$key} : q{};
 667 }
 668
 669 sub _interchange_sr_identifier {
 670     my ( $identification, $qualifier ) = @_;
 671
 672     if ( !$identification ) {
 673         $identification = 'RANDOM';
 674         $qualifier      = '92';
 675         carp 'undefined identifier';
 676     }
 677
 678     # 14   EAN International
 679     # 31B   US SAN (preferred)
 680     # also 91 assigned by supplier
 681     # also 92 assigned by buyer
 682     if ( $qualifier !~ m/^(?:14|31B|91|92)/xms ) {
 683         $qualifier = '92';
 684     }
 685
 686     return "+$identification:$qualifier";
 687 }
 688
 689 sub encode_text {
 690     my $string = shift;
 691     if ($string) {
 692         $string =~ s/[?]/??/g;
 693         $string =~ s/'/?'/g;
 694         $string =~ s/:/?:/g;
 695         $string =~ s/[+]/?+/g;
 696     }
 697     return $string;
 698 }
 699
 700 1;
 701 __END__
 702
 703 =head1 NAME
 704
 705 Koha::Edifact::Order
 706
 707 =head1 SYNOPSIS
 708
 709 Format an Edifact Order message from a Koha basket
 710
 711 =head1 DESCRIPTION
 712
 713 Generates an Edifact format Order message for a Koha basket.
 714 Normally the only methods used directly by the caller would be
 715 new to set up the message, encode to return the formatted message
 716 and filename to obtain a name under which to store the message
 717
 718 =head1 BUGS
 719
 720 Should integrate into Koha::Edifact namespace
 721 Can caller interface be made cleaner?
 722 Make handling of GIR segments more customizable
 723
 724 =head1 METHODS
 725
 726 =head2 new
 727
 728   my $edi_order = Edifact::Order->new(
 729   orderlines => \@orderlines,
 730   vendor     => $vendor_edi_account,
 731   ean        => $library_ean
 732   );
 733
 734   instantiate the Edifact::Order object, all parameters are Schema::Resultset objects
 735   Called in Koha::Edifact create_edi_order
 736
 737 =head2 filename
 738
 739    my $filename = $edi_order->filename()
 740
 741    returns a filename for the edi order. The filename embeds a reference to the
 742    basket the message was created to encode
 743
 744 =head2 encode
 745
 746    my $edifact_message = $edi_order->encode();
 747
 748    Encodes the basket as a valid edifact message ready for transmission
 749
 750 =head2 initial_service_segments
 751
 752     Creates the service segments which begin the message
 753
 754 =head2 interchange_header
 755
 756     Return an interchange header encoding sender and recipient
 757     ids message date and standards
 758
 759 =head2 user_data_message_segments
 760
 761     Include message data within the encoded message
 762
 763 =head2 message_trailer
 764
 765     Terminate message data including control data on number
 766     of messages and segments included
 767
 768 =head2 trailing_service_segments
 769
 770    Include the service segments occurring at the end of the message
 771
 772 =head2 interchange_control_reference
 773
 774    Returns the unique interchange control reference as a 14 digit number
 775
 776 =head2 message_reference
 777
 778     On generates and subsequently returns the unique message
 779     reference number as a 12 digit number preceded by ME, to generate a new number
 780     pass the string 'new'.
 781     In practice we encode 1 message per transmission so there is only one message
 782     referenced. were we to encode multiple messages a new reference would be
 783     neaded for each
 784
 785 =head2 message_header
 786
 787     Commences a new message
 788
 789 =head2 interchange_trailer
 790
 791     returns the UNZ segment which ends the tranmission encoding the
 792     message count and control reference for the interchange
 793
 794 =head2 order_msg_header
 795
 796     Formats the message header segments
 797
 798 =head2 beginning_of_message
 799
 800     Returns the BGM segment which includes the Koha basket number
 801
 802 =head2 name_and_address
 803
 804     Parameters: Function ( BUYER, DELIVERY, INVOICE, SUPPLIER)
 805                 Id
 806                 Agency
 807
 808     Returns a NAD segment containg the id and agency for for the Function
 809     value. Handles the fact that NAD segments encode the value for 'EAN' differently
 810     to elsewhere.
 811
 812 =head2 order_line
 813
 814     Creates the message segments wncoding an order line
 815
 816 =head2 item_description
 817
 818     Encodes the biblio item fields Author, title, publisher, date of publication
 819     binding
 820
 821 =head2 imd_segment
 822
 823     Formats an IMD segment, handles the chunking of data into the 35 character
 824     lengths required and the creation of repeat segments
 825
 826 =head2 gir_segments
 827
 828     Add item level information
 829
 830 =head2 add_gir_identity_number
 831
 832     Handle the formatting of a GIR element
 833     return empty string if no data
 834
 835 =head2 add_seg
 836
 837     Adds a parssed array of segments to the objects segment list
 838     ensures all segments are properly terminated by '
 839
 840 =head2 lin_segment
 841
 842     Adds a LIN segment consisting of the line number and the ean number
 843     if the passed isbn is valid
 844
 845 =head2 additional_product_id
 846
 847     Add a PIA segment for an additional product id
 848
 849 =head2 message_date_segment
 850
 851     Passed a DateTime object returns a correctly formatted DTM segment
 852
 853 =head2 _const
 854
 855     Stores and returns constant strings for service_string_advice
 856     and message_identifier
 857     TBD replace with class variables
 858
 859 =head2 _interchange_sr_identifier
 860
 861     Format sender and receipient identifiers for use in the interchange header
 862
 863 =head2 encode_text
 864
 865     Encode textual data into the standard character set ( iso 8859-1 )
 866     and quote any Edifact metacharacters
 867
 868 =head2 msg_date_string
 869
 870     Convenient routine which returns message date as a Y-m-d string
 871     useful if the caller wants to log date of creation
 872
 873 =head1 AUTHOR
 874
 875    Colin Campbell <colin.campbell@ptfs-europe.com>
 876
 877
 878 =head1 COPYRIGHT
 879
 880    Copyright 2014,2015,2016 PTFS-Europe Ltd
 881    This program is free software, You may redistribute it under
 882    under the terms of the GNU General Public License
 883
 884
 885 =cut