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