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