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