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