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
 108     # Guard against CR LF etc being added in data from DB
 109     $self->{transmission}=~s/[\r\n\t]//g;
 110
 111     return $self->{transmission};
 112 }
 113
 114 sub msg_date_string {
 115     my $self = shift;
 116     return $self->{message_date}->ymd();
 117 }
 118
 119 sub initial_service_segments {
 120     my $self = shift;
 121
 122     #UNA service string advice - specifies standard separators
 123     my $segs = _const('service_string_advice');
 124
 125     #UNB interchange header
 126     $segs .= $self->interchange_header();
 127
 128     #UNG functional group header NOT USED
 129     return $segs;
 130 }
 131
 132 sub interchange_header {
 133     my $self = shift;
 134
 135     # syntax identifier
 136     my $hdr =
 137       'UNB+UNOC:3';    # controlling agency character set syntax version number
 138                        # Interchange Sender
 139     $hdr .= _interchange_sr_identifier( $self->{sender}->ean,
 140         $self->{sender}->id_code_qualifier );    # interchange sender
 141     $hdr .= _interchange_sr_identifier( $self->{recipient}->san,
 142         $self->{recipient}->id_code_qualifier );    # interchange Recipient
 143
 144     $hdr .= $separator;
 145
 146     # DateTime of preparation
 147     $hdr .= $self->{message_date}->format_cldr('yyMMdd:HHmm');
 148     $hdr .= $separator;
 149     $hdr .= $self->interchange_control_reference();
 150     $hdr .= $separator;
 151
 152     # Recipents reference password not usually used in edifact
 153     $hdr .= q{+ORDERS};                             # application reference
 154
 155 #Edifact does not usually include the following
 156 #    $hdr .= $separator; # Processing priority  not usually used in edifact
 157 #    $hdr .= $separator; # Acknowledgewment request : not usually used in edifact
 158 #    $hdr .= q{+EANCOM} # Communications agreement id
 159 #    $hdr .= q{+1} # Test indicator
 160 #
 161     $hdr .= $seg_terminator;
 162     return $hdr;
 163 }
 164
 165 sub user_data_message_segments {
 166     my $self = shift;
 167
 168     #UNH message_header  :: seg count begins here
 169     $self->message_header();
 170
 171     $self->order_msg_header();
 172
 173     my $line_number = 0;
 174     foreach my $ol ( @{ $self->{orderlines} } ) {
 175         ++$line_number;
 176         $self->order_line( $line_number, $ol );
 177     }
 178
 179     $self->message_trailer();
 180
 181     my $data_segment_string = join q{}, @{ $self->{segs} };
 182     return $data_segment_string;
 183 }
 184
 185 sub message_trailer {
 186     my $self = shift;
 187
 188     # terminate the message
 189     $self->add_seg("UNS+S$seg_terminator");
 190
 191     # CNT Control_Total
 192     # Could be (code  1) total value of QTY segments
 193     # or ( code = 2 ) number of lineitems
 194     my $num_orderlines = @{ $self->{orderlines} };
 195     $self->add_seg("CNT+2:$num_orderlines$seg_terminator");
 196
 197     # UNT Message Trailer
 198     my $segments_in_message =
 199       1 + @{ $self->{segs} };    # count incl UNH & UNT (!!this one)
 200     my $reference = $self->message_reference('current');
 201     $self->add_seg("UNT+$segments_in_message+$reference$seg_terminator");
 202     return;
 203 }
 204
 205 sub trailing_service_segments {
 206     my $self    = shift;
 207     my $trailer = q{};
 208
 209     #UNE functional group trailer NOT USED
 210     #UNZ interchange trailer
 211     $trailer .= $self->interchange_trailer();
 212
 213     return $trailer;
 214 }
 215
 216 sub interchange_control_reference {
 217     my $self = shift;
 218     if ( $self->{interchange_control_reference} ) {
 219         return sprintf '%014d', $self->{interchange_control_reference};
 220     }
 221     else {
 222         carp 'calling for ref of unencoded order';
 223         return 'NONE ASSIGNED';
 224     }
 225 }
 226
 227 sub message_reference {
 228     my ( $self, $function ) = @_;
 229     if ( $function eq 'new' || !$self->{message_reference_no} ) {
 230
 231         # unique 14 char mesage ref
 232         $self->{message_reference_no} = sprintf 'ME%012d', int rand($NINES_12);
 233     }
 234     return $self->{message_reference_no};
 235 }
 236
 237 sub message_header {
 238     my $self = shift;
 239
 240     $self->{segs} = [];          # initialize the message
 241     $self->{message_count}++;    # In practice alwaya 1
 242
 243     my $hdr = q{UNH+} . $self->message_reference('new');
 244     $hdr .= _const('message_identifier');
 245     $self->add_seg($hdr);
 246     return;
 247 }
 248
 249 sub interchange_trailer {
 250     my $self = shift;
 251
 252     my $t = "UNZ+$self->{message_count}+";
 253     $t .= $self->interchange_control_reference;
 254     $t .= $seg_terminator;
 255     return $t;
 256 }
 257
 258 sub order_msg_header {
 259     my $self = shift;
 260     my @header;
 261
 262     # UNH  see message_header
 263     # BGM
 264     push @header,
 265       beginning_of_message(
 266         $self->{basket}->basketno,
 267         $self->{recipient}->san,
 268         $self->{is_response}
 269       );
 270
 271     # DTM
 272     push @header, message_date_segment( $self->{message_date} );
 273
 274     # NAD-RFF buyer supplier ids
 275     push @header,
 276       name_and_address(
 277         'BUYER',
 278         $self->{sender}->ean,
 279         $self->{sender}->id_code_qualifier
 280       );
 281     push @header,
 282       name_and_address(
 283         'SUPPLIER',
 284         $self->{recipient}->san,
 285         $self->{recipient}->id_code_qualifier
 286       );
 287
 288     # repeat for for other relevant parties
 289
 290     # CUX currency
 291     # ISO 4217 code to show default currency prices are quoted in
 292     # e.g. CUX+2:GBP:9'
 293     # TBD currency handling
 294
 295     $self->add_seg(@header);
 296     return;
 297 }
 298
 299 sub beginning_of_message {
 300     my $basketno            = shift;
 301     my $supplier_san        = shift;
 302     my $response            = shift;
 303     my $document_message_no = sprintf '%011d', $basketno;
 304
 305   # Peters & Bolinda use the BIC recommendation to use 22V a code not in Edifact
 306   # If the order is in response to a quote
 307     my %bic_sans = (
 308         '5013546025065' => 'Peters',
 309         '9377779308820' => 'Bolinda',
 310     );
 311
 312     #    my $message_function = 9;    # original 7 = retransmission
 313     # message_code values
 314     #      220 prder
 315     #      224 rush order
 316     #      228 sample order :: order for approval / inspection copies
 317     #      22C continuation  order for volumes in a set etc.
 318     #    my $message_code = '220';
 319     if ( exists $bic_sans{$supplier_san} && $response ) {
 320         return "BGM+22V+$document_message_no+9$seg_terminator";
 321     }
 322
 323     return "BGM+220+$document_message_no+9$seg_terminator";
 324 }
 325
 326 sub name_and_address {
 327     my ( $party, $id_code, $id_agency ) = @_;
 328     my %qualifier_code = (
 329         BUYER    => 'BY',
 330         DELIVERY => 'DP',    # delivery location if != buyer
 331         INVOICEE => 'IV',    # if different from buyer
 332         SUPPLIER => 'SU',
 333     );
 334     if ( !exists $qualifier_code{$party} ) {
 335         carp "No qualifier code for $party";
 336         return;
 337     }
 338     if ( $id_agency eq '14' ) {
 339         $id_agency = '9';    # ean coded differently in this seg
 340     }
 341
 342     return "NAD+$qualifier_code{$party}+${id_code}::$id_agency$seg_terminator";
 343 }
 344
 345 sub order_line {
 346     my ( $self, $linenumber, $orderline ) = @_;
 347
 348     my $basket = Koha::Acquisition::Orders->find( $orderline->ordernumber )->basket;
 349
 350     my $schema = $self->{schema};
 351     if ( !$orderline->biblionumber )
 352     {                        # cannot generate an orderline without a bib record
 353         return;
 354     }
 355     my $biblionumber = $orderline->biblionumber->biblionumber;
 356     my @biblioitems  = $schema->resultset('Biblioitem')
 357       ->search( { biblionumber => $biblionumber, } );
 358     my $biblioitem = $biblioitems[0];    # makes the assumption there is 1 only
 359                                          # or else all have same details
 360
 361     my $id_string = $orderline->line_item_id;
 362
 363     # LIN line-number in msg :: if we had a 13 digit ean we could add
 364     $self->add_seg( lin_segment( $linenumber, $id_string ) );
 365
 366     # PIA isbn or other id
 367     my @identifiers;
 368     foreach my $id ( $biblioitem->ean, $biblioitem->issn, $biblioitem->isbn ) {
 369         if ( $id && $id ne $id_string ) {
 370             push @identifiers, $id;
 371         }
 372     }
 373     $self->add_seg( additional_product_id( join( ' ', @identifiers ) ) );
 374
 375     #  biblio description
 376     $self->add_seg( item_description( $orderline->biblionumber, $biblioitem ) );
 377
 378     # QTY order quantity
 379     my $qty = join q{}, 'QTY+21:', $orderline->quantity, $seg_terminator;
 380     $self->add_seg($qty);
 381
 382     # DTM Optional date constraints on delivery
 383     #     we dont currently support this in koha
 384     # GIR copy-related data
 385     my @items;
 386     if ( $basket->effective_create_items eq 'ordering' ) {
 387         my @linked_itemnumbers = $orderline->aqorders_items;
 388
 389         foreach my $item (@linked_itemnumbers) {
 390             my $i_obj = $schema->resultset('Item')->find( $item->itemnumber );
 391             if ( defined $i_obj ) {
 392                 push @items, $i_obj;
 393             }
 394         }
 395     }
 396     else {
 397         my $item_hash = {
 398             itemtype  => $biblioitem->itemtype,
 399             shelfmark => $biblioitem->cn_class,
 400         };
 401         my $branch = $orderline->basketno->deliveryplace;
 402         if ($branch) {
 403             $item_hash->{branch} = $branch;
 404         }
 405         for ( 1 .. $orderline->quantity ) {
 406             push @items, $item_hash;
 407         }
 408     }
 409     my $budget = GetBudget( $orderline->budget_id );
 410     my $ol_fields = { budget_code => $budget->{budget_code}, };
 411     if ( $orderline->order_vendornote ) {
 412         $ol_fields->{servicing_instruction} = $orderline->order_vendornote;
 413         chomp $ol_fields->{servicing_instruction};
 414     }
 415
 416     my $item_fields = [];
 417     for my $item (@items) {
 418         push @{$item_fields},
 419           {
 420             branchcode     => $item->homebranch->branchcode,
 421             itype          => $item->itype,
 422             location       => $item->location,
 423             itemcallnumber => $item->itemcallnumber,
 424           };
 425     }
 426     $self->add_seg(
 427         gir_segments(
 428             {
 429                 ol_fields => $ol_fields,
 430                 items     => $item_fields
 431             }
 432         )
 433     );
 434
 435     # TBD what if #items exceeds quantity
 436
 437     # FTX free text for current orderline TBD
 438     #    dont really have a special instructions field to encode here
 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