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