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