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