Koha/EDI.pm

   1 package Koha::EDI;
   2
   3 # Copyright 2014,2015 PTFS-Europe Ltd
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use strict;
  21 use warnings;
  22 use base qw(Exporter);
  23 use utf8;
  24 use Carp;
  25 use English qw{ -no_match_vars };
  26 use Business::ISBN;
  27 use DateTime;
  28 use C4::Context;
  29 use Koha::Database;
  30 use C4::Acquisition qw( NewBasket CloseBasket ModOrder);
  31 use C4::Suggestions qw( ModSuggestion );
  32 use C4::Items qw(AddItem);
  33 use C4::Biblio qw( AddBiblio TransformKohaToMarc GetMarcBiblio );
  34 use Koha::Edifact::Order;
  35 use Koha::Edifact;
  36 use Log::Log4perl;
  37 use Text::Unidecode;
  38 use Koha::Plugins::Handler;
  39
  40 our $VERSION = 1.1;
  41 our @EXPORT_OK =
  42   qw( process_quote process_invoice process_ordrsp create_edi_order get_edifact_ean );
  43
  44 sub create_edi_order {
  45     my $parameters = shift;
  46     my $basketno   = $parameters->{basketno};
  47     my $ean        = $parameters->{ean};
  48     my $branchcode = $parameters->{branchcode};
  49     my $noingest   = $parameters->{noingest};
  50     $ean ||= C4::Context->preference('EDIfactEAN');
  51     if ( !$basketno || !$ean ) {
  52         carp 'create_edi_order called with no basketno or ean';
  53         return;
  54     }
  55
  56     my $schema = Koha::Database->new()->schema();
  57
  58     my @orderlines = $schema->resultset('Aqorder')->search(
  59         {
  60             basketno    => $basketno,
  61             orderstatus => 'new',
  62         }
  63     )->all;
  64
  65     if ( !@orderlines ) {
  66         carp "No orderlines for basket $basketno";
  67         return;
  68     }
  69
  70     my $vendor = $schema->resultset('VendorEdiAccount')->search(
  71         {
  72             vendor_id => $orderlines[0]->basketno->booksellerid->id,
  73         }
  74     )->single;
  75
  76     my $ean_search_keys = { ean => $ean, };
  77     if ($branchcode) {
  78         $ean_search_keys->{branchcode} = $branchcode;
  79     }
  80     my $ean_obj =
  81       $schema->resultset('EdifactEan')->search($ean_search_keys)->single;
  82
  83     my $dbh     = C4::Context->dbh;
  84     my $arr_ref = $dbh->selectcol_arrayref(
  85 'select id from edifact_messages where basketno = ? and message_type = \'QUOTE\'',
  86         {}, $basketno
  87     );
  88     my $response = @{$arr_ref} ? 1 : 0;
  89
  90     my $edifact_order_params = {
  91         orderlines  => \@orderlines,
  92         vendor      => $vendor,
  93         ean         => $ean_obj,
  94         is_response => $response,
  95     };
  96
  97     my $edifact;
  98     if ( $vendor->plugin ) {
  99         $edifact = Koha::Plugins::Handler->run(
 100             {
 101                 class  => $vendor->plugin,
 102                 method => 'edifact_order',
 103                 params => {
 104                     params => $edifact_order_params,
 105                 }
 106             }
 107         );
 108     }
 109     else {
 110         $edifact = Koha::Edifact::Order->new($edifact_order_params);
 111     }
 112
 113     return unless $edifact;
 114
 115     my $order_file = $edifact->encode();
 116
 117     # ingest result
 118     if ($order_file) {
 119         my $m = unidecode($order_file);  # remove diacritics and non-latin chars
 120         if ($noingest) {                 # allows scripts to produce test files
 121             return $m;
 122         }
 123         my $order = {
 124             message_type  => 'ORDERS',
 125             raw_msg       => $m,
 126             vendor_id     => $vendor->vendor_id,
 127             status        => 'Pending',
 128             basketno      => $basketno,
 129             filename      => $edifact->filename(),
 130             transfer_date => $edifact->msg_date_string(),
 131             edi_acct      => $vendor->id,
 132
 133         };
 134         $schema->resultset('EdifactMessage')->create($order);
 135         return 1;
 136     }
 137
 138     return;
 139 }
 140
 141 sub process_ordrsp {
 142     my $response_message = shift;
 143     $response_message->status('processing');
 144     $response_message->update;
 145     my $schema = Koha::Database->new()->schema();
 146     my $logger = Log::Log4perl->get_logger();
 147     my $vendor_acct;
 148     my $edi =
 149       Koha::Edifact->new( { transmission => $response_message->raw_msg, } );
 150     my $messages = $edi->message_array();
 151
 152     if ( @{$messages} ) {
 153         foreach my $msg ( @{$messages} ) {
 154             my $lines = $msg->lineitems();
 155             foreach my $line ( @{$lines} ) {
 156                 my $ordernumber = $line->ordernumber();
 157
 158        # action cancelled:change_requested:no_action:accepted:not_found:recorded
 159                 my $action = $line->action_notification();
 160                 if ( $action eq 'cancelled' ) {
 161                     my $reason = $line->coded_orderline_text();
 162                     ModOrder(
 163                         {
 164                             ordernumber             => $ordernumber,
 165                             cancellationreason      => $reason,
 166                             orderstatus             => 'cancelled',
 167                             datecancellationprinted => DateTime->now()->ymd(),
 168                         }
 169                     );
 170                 }
 171                 else {    # record order as due with possible further info
 172
 173                     my $report     = $line->coded_orderline_text();
 174                     my $date_avail = $line->availability_date();
 175                     $report ||= q{};
 176                     if ($date_avail) {
 177                         $report .= " Available: $date_avail";
 178                     }
 179                     ModOrder(
 180                         {
 181                             ordernumber      => $ordernumber,
 182                             suppliers_report => $report,
 183                         }
 184                     );
 185                 }
 186             }
 187         }
 188     }
 189
 190     $response_message->status('received');
 191     $response_message->update;
 192     return;
 193 }
 194
 195 sub process_invoice {
 196     my $invoice_message = shift;
 197     $invoice_message->status('processing');
 198     $invoice_message->update;
 199     my $schema = Koha::Database->new()->schema();
 200     my $logger = Log::Log4perl->get_logger();
 201     my $vendor_acct;
 202
 203     my $plugin = $invoice_message->edi_acct()->plugin();
 204     my $edi_plugin;
 205     if ( $plugin ) {
 206         $edi_plugin = Koha::Plugins::Handler->run(
 207             {
 208                 class  => $plugin,
 209                 method => 'edifact',
 210                 params => {
 211                     invoice_message => $invoice_message,
 212                     transmission => $invoice_message->raw_msg,
 213                 }
 214             }
 215         );
 216     }
 217
 218     my $edi = $edi_plugin ||
 219       Koha::Edifact->new( { transmission => $invoice_message->raw_msg, } );
 220
 221     my $messages = $edi->message_array();
 222
 223     if ( @{$messages} ) {
 224
 225         # BGM contains an invoice number
 226         foreach my $msg ( @{$messages} ) {
 227             my $invoicenumber  = $msg->docmsg_number();
 228             my $shipmentcharge = $msg->shipment_charge();
 229             my $msg_date       = $msg->message_date;
 230             my $tax_date       = $msg->tax_point_date;
 231             if ( !defined $tax_date || $tax_date !~ m/^\d{8}/xms ) {
 232                 $tax_date = $msg_date;
 233             }
 234
 235             my $vendor_ean = $msg->supplier_ean;
 236             if ( !defined $vendor_acct || $vendor_ean ne $vendor_acct->san ) {
 237                 $vendor_acct = $schema->resultset('VendorEdiAccount')->search(
 238                     {
 239                         san => $vendor_ean,
 240                     }
 241                 )->single;
 242             }
 243             if ( !$vendor_acct ) {
 244                 carp
 245 "Cannot find vendor with ean $vendor_ean for invoice $invoicenumber in $invoice_message->filename";
 246                 next;
 247             }
 248             $invoice_message->edi_acct( $vendor_acct->id );
 249             $logger->trace("Adding invoice:$invoicenumber");
 250             my $new_invoice = $schema->resultset('Aqinvoice')->create(
 251                 {
 252                     invoicenumber         => $invoicenumber,
 253                     booksellerid          => $invoice_message->vendor_id,
 254                     shipmentdate          => $msg_date,
 255                     billingdate           => $tax_date,
 256                     shipmentcost          => $shipmentcharge,
 257                     shipmentcost_budgetid => $vendor_acct->shipment_budget,
 258                     message_id            => $invoice_message->id,
 259                 }
 260             );
 261             my $invoiceid = $new_invoice->invoiceid;
 262             $logger->trace("Added as invoiceno :$invoiceid");
 263             my $lines = $msg->lineitems();
 264
 265             foreach my $line ( @{$lines} ) {
 266                 my $ordernumber = $line->ordernumber;
 267                 $logger->trace( "Receipting order:$ordernumber Qty: ",
 268                     $line->quantity );
 269
 270                 my $order = $schema->resultset('Aqorder')->find($ordernumber);
 271
 272       # ModReceiveOrder does not validate that $ordernumber exists validate here
 273                 if ($order) {
 274
 275                     # check suggestions
 276                     my $s = $schema->resultset('Suggestion')->search(
 277                         {
 278                             biblionumber => $order->biblionumber->biblionumber,
 279                         }
 280                     )->single;
 281                     if ($s) {
 282                         ModSuggestion(
 283                             {
 284                                 suggestionid => $s->suggestionid,
 285                                 STATUS       => 'AVAILABLE',
 286                             }
 287                         );
 288                     }
 289
 290                     my $price = _get_invoiced_price($line);
 291
 292                     if ( $order->quantity > $line->quantity ) {
 293                         my $ordered = $order->quantity;
 294
 295                         # part receipt
 296                         $order->orderstatus('partial');
 297                         $order->quantity( $ordered - $line->quantity );
 298                         $order->update;
 299                         my $received_order = $order->copy(
 300                             {
 301                                 ordernumber      => undef,
 302                                 quantity         => $line->quantity,
 303                                 quantityreceived => $line->quantity,
 304                                 orderstatus      => 'complete',
 305                                 unitprice        => $price,
 306                                 invoiceid        => $invoiceid,
 307                                 datereceived     => $msg_date,
 308                             }
 309                         );
 310                         transfer_items( $schema, $line, $order,
 311                             $received_order );
 312                         receipt_items( $schema, $line,
 313                             $received_order->ordernumber );
 314                     }
 315                     else {    # simple receipt all copies on order
 316                         $order->quantityreceived( $line->quantity );
 317                         $order->datereceived($msg_date);
 318                         $order->invoiceid($invoiceid);
 319                         $order->unitprice($price);
 320                         $order->orderstatus('complete');
 321                         $order->update;
 322                         receipt_items( $schema, $line, $ordernumber );
 323                     }
 324                 }
 325                 else {
 326                     $logger->error(
 327                         "No order found for $ordernumber Invoice:$invoicenumber"
 328                     );
 329                     next;
 330                 }
 331
 332             }
 333
 334         }
 335     }
 336
 337     $invoice_message->status('received');
 338     $invoice_message->update;    # status and basketno link
 339     return;
 340 }
 341
 342 sub _get_invoiced_price {
 343     my $line  = shift;
 344     my $price = $line->price_net;
 345     if ( !defined $price ) {  # no net price so generate it from lineitem amount
 346         $price = $line->amt_lineitem;
 347         if ( $price and $line->quantity > 1 ) {
 348             $price /= $line->quantity;    # div line cost by qty
 349         }
 350     }
 351     return $price;
 352 }
 353
 354 sub receipt_items {
 355     my ( $schema, $inv_line, $ordernumber ) = @_;
 356     my $logger   = Log::Log4perl->get_logger();
 357     my $quantity = $inv_line->quantity;
 358
 359     # itemnumber is not a foreign key ??? makes this a bit cumbersome
 360     my @item_links = $schema->resultset('AqordersItem')->search(
 361         {
 362             ordernumber => $ordernumber,
 363         }
 364     );
 365     my %branch_map;
 366     foreach my $ilink (@item_links) {
 367         my $item = $schema->resultset('Item')->find( $ilink->itemnumber );
 368         if ( !$item ) {
 369             my $i = $ilink->itemnumber;
 370             $logger->warn(
 371                 "Cannot find aqorder item for $i :Order:$ordernumber");
 372             next;
 373         }
 374         my $b = $item->homebranch->branchcode;
 375         if ( !exists $branch_map{$b} ) {
 376             $branch_map{$b} = [];
 377         }
 378         push @{ $branch_map{$b} }, $item;
 379     }
 380     my $gir_occurrence = 0;
 381     while ( $gir_occurrence < $quantity ) {
 382         my $branch = $inv_line->girfield( 'branch', $gir_occurrence );
 383         my $item = shift @{ $branch_map{$branch} };
 384         if ($item) {
 385             my $barcode = $inv_line->girfield( 'barcode', $gir_occurrence );
 386             if ( $barcode && !$item->barcode ) {
 387                 my $rs = $schema->resultset('Item')->search(
 388                     {
 389                         barcode => $barcode,
 390                     }
 391                 );
 392                 if ( $rs->count > 0 ) {
 393                     $logger->warn("Barcode $barcode is a duplicate");
 394                 }
 395                 else {
 396
 397                     $logger->trace("Adding barcode $barcode");
 398                     $item->barcode($barcode);
 399                 }
 400             }
 401
 402             $item->update;
 403         }
 404         else {
 405             $logger->warn("Unmatched item at branch:$branch");
 406         }
 407         ++$gir_occurrence;
 408     }
 409     return;
 410
 411 }
 412
 413 sub transfer_items {
 414     my ( $schema, $inv_line, $order_from, $order_to ) = @_;
 415
 416     # Transfer x items from the orig order to a completed partial order
 417     my $quantity = $inv_line->quantity;
 418     my $gocc     = 0;
 419     my %mapped_by_branch;
 420     while ( $gocc < $quantity ) {
 421         my $branch = $inv_line->girfield( 'branch', $gocc );
 422         if ( !exists $mapped_by_branch{$branch} ) {
 423             $mapped_by_branch{$branch} = 1;
 424         }
 425         else {
 426             $mapped_by_branch{$branch}++;
 427         }
 428         ++$gocc;
 429     }
 430     my $logger = Log::Log4perl->get_logger();
 431     my $o1     = $order_from->ordernumber;
 432     my $o2     = $order_to->ordernumber;
 433     $logger->warn("transferring $quantity copies from order $o1 to order $o2");
 434
 435     my @item_links = $schema->resultset('AqordersItem')->search(
 436         {
 437             ordernumber => $order_from->ordernumber,
 438         }
 439     );
 440     foreach my $ilink (@item_links) {
 441         my $ino      = $ilink->itemnumber;
 442         my $item     = $schema->resultset('Item')->find( $ilink->itemnumber );
 443         my $i_branch = $item->homebranch;
 444         if ( exists $mapped_by_branch{$i_branch}
 445             && $mapped_by_branch{$i_branch} > 0 )
 446         {
 447             $ilink->ordernumber( $order_to->ordernumber );
 448             $ilink->update;
 449             --$quantity;
 450             --$mapped_by_branch{$i_branch};
 451             $logger->warn("Transferred item $item");
 452         }
 453         else {
 454             $logger->warn("Skipped item $item");
 455         }
 456         if ( $quantity < 1 ) {
 457             last;
 458         }
 459     }
 460
 461     return;
 462 }
 463
 464 sub process_quote {
 465     my $quote = shift;
 466
 467     $quote->status('processing');
 468     $quote->update;
 469
 470     my $edi = Koha::Edifact->new( { transmission => $quote->raw_msg, } );
 471
 472     my $messages       = $edi->message_array();
 473     my $process_errors = 0;
 474     my $logger         = Log::Log4perl->get_logger();
 475     my $schema         = Koha::Database->new()->schema();
 476     my $message_count  = 0;
 477     my @added_baskets;    # if auto & multiple baskets need to order all
 478
 479     if ( @{$messages} && $quote->vendor_id ) {
 480         foreach my $msg ( @{$messages} ) {
 481             ++$message_count;
 482             my $basketno =
 483               NewBasket( $quote->vendor_id, 0, $quote->filename, q{},
 484                 q{} . q{} );
 485             push @added_baskets, $basketno;
 486             if ( $message_count > 1 ) {
 487                 my $m_filename = $quote->filename;
 488                 $m_filename .= "_$message_count";
 489                 $schema->resultset('EdifactMessage')->create(
 490                     {
 491                         message_type  => $quote->message_type,
 492                         transfer_date => $quote->transfer_date,
 493                         vendor_id     => $quote->vendor_id,
 494                         edi_acct      => $quote->edi_acct,
 495                         status        => 'recmsg',
 496                         basketno      => $basketno,
 497                         raw_msg       => q{},
 498                         filename      => $m_filename,
 499                     }
 500                 );
 501             }
 502             else {
 503                 $quote->basketno($basketno);
 504             }
 505             $logger->trace("Created basket :$basketno");
 506             my $items  = $msg->lineitems();
 507             my $refnum = $msg->message_refno;
 508
 509             for my $item ( @{$items} ) {
 510                 if ( !quote_item( $item, $quote, $basketno ) ) {
 511                     ++$process_errors;
 512                 }
 513             }
 514         }
 515     }
 516     my $status = 'received';
 517     if ($process_errors) {
 518         $status = 'error';
 519     }
 520
 521     $quote->status($status);
 522     $quote->update;    # status and basketno link
 523                        # Do we automatically generate orders for this vendor
 524     my $v = $schema->resultset('VendorEdiAccount')->search(
 525         {
 526             vendor_id => $quote->vendor_id,
 527         }
 528     )->single;
 529     if ( $v->auto_orders ) {
 530         for my $b (@added_baskets) {
 531             create_edi_order(
 532                 {
 533
 534                     basketno => $b,
 535                 }
 536             );
 537             CloseBasket($b);
 538         }
 539     }
 540
 541     return;
 542 }
 543
 544 sub quote_item {
 545     my ( $item, $quote, $basketno ) = @_;
 546
 547     my $schema = Koha::Database->new()->schema();
 548
 549     # create biblio record
 550     my $logger = Log::Log4perl->get_logger();
 551     if ( !$basketno ) {
 552         $logger->error('Skipping order creation no basketno');
 553         return;
 554     }
 555     $logger->trace( 'Checking db for matches with ', $item->item_number_id() );
 556     my $bib = _check_for_existing_bib( $item->item_number_id() );
 557     if ( !defined $bib ) {
 558         $bib = {};
 559         my $bib_record = _create_bib_from_quote( $item, $quote );
 560         ( $bib->{biblionumber}, $bib->{biblioitemnumber} ) =
 561           AddBiblio( $bib_record, q{} );
 562         $logger->trace("New biblio added $bib->{biblionumber}");
 563     }
 564     else {
 565         $logger->trace("Match found: $bib->{biblionumber}");
 566     }
 567
 568     # Create an orderline
 569     my $order_note = $item->{orderline_free_text};
 570     $order_note ||= q{};
 571     my $order_quantity = $item->quantity();
 572     my $gir_count      = $item->number_of_girs();
 573     $order_quantity ||= 1;    # quantity not necessarily present
 574     if ( $gir_count > 1 ) {
 575         if ( $gir_count != $order_quantity ) {
 576             $logger->error(
 577                 "Order for $order_quantity items, $gir_count segments present");
 578         }
 579         $order_quantity = 1;    # attempts to create an orderline for each gir
 580     }
 581
 582     # database definitions should set some of these defaults but dont
 583     my $order_hash = {
 584         biblionumber       => $bib->{biblionumber},
 585         entrydate          => DateTime->now( time_zone => 'local' )->ymd(),
 586         basketno           => $basketno,
 587         listprice          => $item->price,
 588         quantity           => $order_quantity,
 589         quantityreceived   => 0,
 590         order_vendornote   => q{},
 591         order_internalnote => $order_note,
 592         rrp                => $item->price,
 593         ecost => _discounted_price( $quote->vendor->discount, $item->price ),
 594         uncertainprice => 0,
 595         sort1          => q{},
 596         sort2          => q{},
 597     };
 598
 599     # suppliers references
 600     if ( $item->reference() ) {
 601         $order_hash->{suppliers_reference_number}    = $item->reference;
 602         $order_hash->{suppliers_reference_qualifier} = 'QLI';
 603     }
 604     elsif ( $item->orderline_reference_number() ) {
 605         $order_hash->{suppliers_reference_number} =
 606           $item->orderline_reference_number;
 607         $order_hash->{suppliers_reference_qualifier} = 'SLI';
 608     }
 609     if ( $item->item_number_id ) {    # suppliers ean
 610         $order_hash->{line_item_id} = $item->item_number_id;
 611     }
 612
 613     if ( $item->girfield('servicing_instruction') ) {
 614         my $occ = 0;
 615         my $txt = q{};
 616         my $si;
 617         while ( $si = $item->girfield( 'servicing_instruction', $occ ) ) {
 618             if ($occ) {
 619                 $txt .= q{: };
 620             }
 621             $txt .= $si;
 622             ++$occ;
 623         }
 624         $order_hash->{order_vendornote} = $txt;
 625     }
 626
 627     if ( $item->internal_notes() ) {
 628         if ( $order_hash->{order_internalnote} ) {    # more than ''
 629             $order_hash->{order_internalnote} .= q{ };
 630         }
 631         $order_hash->{order_internalnote} .= $item->internal_notes;
 632     }
 633
 634     my $budget = _get_budget( $schema, $item->girfield('fund_allocation') );
 635
 636     my $skip = '0';
 637     if ( !$budget ) {
 638         if ( $item->quantity > 1 ) {
 639             carp 'Skipping line with no budget info';
 640             $logger->trace('girfield skipped for invalid budget');
 641             $skip++;
 642         }
 643         else {
 644             carp 'Skipping line with no budget info';
 645             $logger->trace('orderline skipped for invalid budget');
 646             return;
 647         }
 648     }
 649
 650     my %ordernumber;
 651     my %budgets;
 652     my $item_hash;
 653
 654     if ( !$skip ) {
 655         $order_hash->{budget_id} = $budget->budget_id;
 656         my $first_order = $schema->resultset('Aqorder')->create($order_hash);
 657         my $o           = $first_order->ordernumber();
 658         $logger->trace("Order created :$o");
 659
 660         # should be done by database settings
 661         $first_order->parent_ordernumber( $first_order->ordernumber() );
 662         $first_order->update();
 663
 664         # add to $budgets to prevent duplicate orderlines
 665         $budgets{ $budget->budget_id } = '1';
 666
 667         # record ordernumber against budget
 668         $ordernumber{ $budget->budget_id } = $o;
 669
 670         if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
 671             $item_hash = _create_item_from_quote( $item, $quote );
 672
 673             my $created = 0;
 674             while ( $created < $order_quantity ) {
 675                 my $itemnumber;
 676                 ( $bib->{biblionumber}, $bib->{biblioitemnumber}, $itemnumber )
 677                   = AddItem( $item_hash, $bib->{biblionumber} );
 678                 $logger->trace("Added item:$itemnumber");
 679                 $schema->resultset('AqordersItem')->create(
 680                     {
 681                         ordernumber => $first_order->ordernumber,
 682                         itemnumber  => $itemnumber,
 683                     }
 684                 );
 685                 ++$created;
 686             }
 687         }
 688     }
 689
 690     if ( $order_quantity == 1 && $item->quantity > 1 ) {
 691         my $occurrence = 1;    # occ zero already added
 692         while ( $occurrence < $item->quantity ) {
 693
 694             # check budget code
 695             $budget = _get_budget( $schema,
 696                 $item->girfield( 'fund_allocation', $occurrence ) );
 697
 698             if ( !$budget ) {
 699                 my $bad_budget =
 700                   $item->girfield( 'fund_allocation', $occurrence );
 701                 carp 'Skipping line with no budget info';
 702                 $logger->trace(
 703                     "girfield skipped for invalid budget:$bad_budget");
 704                 ++$occurrence;    ## lets look at the next one not this one again
 705                 next;
 706             }
 707
 708             # add orderline for NEW budget in $budgets
 709             if ( !exists $budgets{ $budget->budget_id } ) {
 710
 711                 # $order_hash->{quantity} = 1; by default above
 712                 # we should handle both 1:1 GIR & 1:n GIR (with LQT values) here
 713
 714                 $order_hash->{budget_id} = $budget->budget_id;
 715
 716                 my $new_order =
 717                   $schema->resultset('Aqorder')->create($order_hash);
 718                 my $o = $new_order->ordernumber();
 719                 $logger->trace("Order created :$o");
 720
 721                 # should be done by database settings
 722                 $new_order->parent_ordernumber( $new_order->ordernumber() );
 723                 $new_order->update();
 724
 725                 # add to $budgets to prevent duplicate orderlines
 726                 $budgets{ $budget->budget_id } = '1';
 727
 728                 # record ordernumber against budget
 729                 $ordernumber{ $budget->budget_id } = $o;
 730
 731                 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
 732                     if ( !defined $item_hash ) {
 733                         $item_hash = _create_item_from_quote( $item, $quote );
 734                     }
 735                     my $new_item = {
 736                         itype =>
 737                           $item->girfield( 'stock_category', $occurrence ),
 738                         location =>
 739                           $item->girfield( 'collection_code', $occurrence ),
 740                         itemcallnumber =>
 741                           $item->girfield( 'shelfmark', $occurrence )
 742                           || $item->girfield( 'classification', $occurrence )
 743                           || title_level_class($item),
 744                         holdingbranch =>
 745                           $item->girfield( 'branch', $occurrence ),
 746                         homebranch => $item->girfield( 'branch', $occurrence ),
 747                     };
 748                     if ( $new_item->{itype} ) {
 749                         $item_hash->{itype} = $new_item->{itype};
 750                     }
 751                     if ( $new_item->{location} ) {
 752                         $item_hash->{location} = $new_item->{location};
 753                     }
 754                     if ( $new_item->{itemcallnumber} ) {
 755                         $item_hash->{itemcallnumber} =
 756                           $new_item->{itemcallnumber};
 757                     }
 758                     if ( $new_item->{holdingbranch} ) {
 759                         $item_hash->{holdingbranch} =
 760                           $new_item->{holdingbranch};
 761                     }
 762                     if ( $new_item->{homebranch} ) {
 763                         $item_hash->{homebranch} = $new_item->{homebranch};
 764                     }
 765
 766                     my $itemnumber;
 767                     ( undef, undef, $itemnumber ) =
 768                       AddItem( $item_hash, $bib->{biblionumber} );
 769                     $logger->trace("New item $itemnumber added");
 770                     $schema->resultset('AqordersItem')->create(
 771                         {
 772                             ordernumber => $new_order->ordernumber,
 773                             itemnumber  => $itemnumber,
 774                         }
 775                     );
 776                 }
 777
 778                 ++$occurrence;
 779             }
 780
 781             # increment quantity in orderline for EXISTING budget in $budgets
 782             else {
 783                 my $row = $schema->resultset('Aqorder')->find(
 784                     {
 785                         ordernumber => $ordernumber{ $budget->budget_id }
 786                     }
 787                 );
 788                 if ($row) {
 789                     my $qty = $row->quantity;
 790                     $qty++;
 791                     $row->update(
 792                         {
 793                             quantity => $qty,
 794                         }
 795                     );
 796                 }
 797
 798                 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
 799                     my $new_item = {
 800                         notforloan       => -1,
 801                         cn_sort          => q{},
 802                         cn_source        => 'ddc',
 803                         price            => $item->price,
 804                         replacementprice => $item->price,
 805                         itype =>
 806                           $item->girfield( 'stock_category', $occurrence ),
 807                         location =>
 808                           $item->girfield( 'collection_code', $occurrence ),
 809                         itemcallnumber =>
 810                           $item->girfield( 'shelfmark', $occurrence )
 811                           || $item->girfield( 'classification', $occurrence )
 812                           || $item_hash->{itemcallnumber},
 813                         holdingbranch =>
 814                           $item->girfield( 'branch', $occurrence ),
 815                         homebranch => $item->girfield( 'branch', $occurrence ),
 816                     };
 817                     my $itemnumber;
 818                     ( undef, undef, $itemnumber ) =
 819                       AddItem( $new_item, $bib->{biblionumber} );
 820                     $logger->trace("New item $itemnumber added");
 821                     $schema->resultset('AqordersItem')->create(
 822                         {
 823                             ordernumber => $ordernumber{ $budget->budget_id },
 824                             itemnumber  => $itemnumber,
 825                         }
 826                     );
 827                 }
 828
 829                 ++$occurrence;
 830             }
 831         }
 832     }
 833     return 1;
 834
 835 }
 836
 837 sub get_edifact_ean {
 838
 839     my $dbh = C4::Context->dbh;
 840
 841     my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean');
 842
 843     return $eans->[0];
 844 }
 845
 846 # We should not need to have a routine to do this here
 847 sub _discounted_price {
 848     my ( $discount, $price ) = @_;
 849     return $price - ( ( $discount * $price ) / 100 );
 850 }
 851
 852 sub _check_for_existing_bib {
 853     my $isbn = shift;
 854
 855     my $search_isbn = $isbn;
 856     $search_isbn =~ s/^\s*/%/xms;
 857     $search_isbn =~ s/\s*$/%/xms;
 858     my $dbh = C4::Context->dbh;
 859     my $sth = $dbh->prepare(
 860 'select biblionumber, biblioitemnumber from biblioitems where isbn like ?',
 861     );
 862     my $tuple_arr =
 863       $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
 864     if ( @{$tuple_arr} ) {
 865         return $tuple_arr->[0];
 866     }
 867     elsif ( length($isbn) == 13 && $isbn !~ /^97[89]/ ) {
 868         my $tarr = $dbh->selectall_arrayref(
 869 'select biblionumber, biblioitemnumber from biblioitems where ean = ?',
 870             { Slice => {} },
 871             $isbn
 872         );
 873         if ( @{$tarr} ) {
 874             return $tarr->[0];
 875         }
 876     }
 877     else {
 878         undef $search_isbn;
 879         $isbn =~ s/\-//xmsg;
 880         if ( $isbn =~ m/(\d{13})/xms ) {
 881             my $b_isbn = Business::ISBN->new($1);
 882             if ( $b_isbn && $b_isbn->is_valid ) {
 883                 $search_isbn = $b_isbn->as_isbn10->as_string( [] );
 884             }
 885
 886         }
 887         elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) {
 888             my $b_isbn = Business::ISBN->new($1);
 889             if ( $b_isbn && $b_isbn->is_valid ) {
 890                 $search_isbn = $b_isbn->as_isbn13->as_string( [] );
 891             }
 892
 893         }
 894         if ($search_isbn) {
 895             $search_isbn = "%$search_isbn%";
 896             $tuple_arr =
 897               $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
 898             if ( @{$tuple_arr} ) {
 899                 return $tuple_arr->[0];
 900             }
 901         }
 902     }
 903     return;
 904 }
 905
 906 # returns a budget obj or undef
 907 # fact we need this shows what a mess Acq API is
 908 sub _get_budget {
 909     my ( $schema, $budget_code ) = @_;
 910     my $period_rs = $schema->resultset('Aqbudgetperiod')->search(
 911         {
 912             budget_period_active => 1,
 913         }
 914     );
 915
 916     # db does not ensure budget code is unque
 917     return $schema->resultset('Aqbudget')->single(
 918         {
 919             budget_code => $budget_code,
 920             budget_period_id =>
 921               { -in => $period_rs->get_column('budget_period_id')->as_query },
 922         }
 923     );
 924 }
 925
 926 # try to get title level classification from incoming quote
 927 sub title_level_class {
 928     my ($item)         = @_;
 929     my $class          = q{};
 930     my $default_scheme = C4::Context->preference('DefaultClassificationSource');
 931     if ( $default_scheme eq 'ddc' ) {
 932         $class = $item->dewey_class();
 933     }
 934     elsif ( $default_scheme eq 'lcc' ) {
 935         $class = $item->lc_class();
 936     }
 937     if ( !$class ) {
 938         $class =
 939              $item->girfield('shelfmark')
 940           || $item->girfield('classification')
 941           || q{};
 942     }
 943     return $class;
 944 }
 945
 946 sub _create_bib_from_quote {
 947
 948     #TBD we should flag this for updating from an external source
 949     #As biblio (&biblioitems) has no candidates flag in order
 950     my ( $item, $quote ) = @_;
 951     my $itemid = $item->item_number_id;
 952     my $defalt_classification_source =
 953       C4::Context->preference('DefaultClassificationSource');
 954     my $bib_hash = {
 955         'biblioitems.cn_source' => $defalt_classification_source,
 956         'items.cn_source'       => $defalt_classification_source,
 957         'items.notforloan'      => -1,
 958         'items.cn_sort'         => q{},
 959     };
 960     $bib_hash->{'biblio.seriestitle'} = $item->series;
 961
 962     $bib_hash->{'biblioitems.publishercode'} = $item->publisher;
 963     $bib_hash->{'biblioitems.publicationyear'} =
 964       $bib_hash->{'biblio.copyrightdate'} = $item->publication_date;
 965
 966     $bib_hash->{'biblio.title'}         = $item->title;
 967     $bib_hash->{'biblio.author'}        = $item->author;
 968     $bib_hash->{'biblioitems.isbn'}     = $item->item_number_id;
 969     $bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category');
 970
 971     # If we have a 13 digit id we are assuming its an ean
 972     # (it may also be an isbn or issn)
 973     if ( $itemid =~ /^\d{13}$/ ) {
 974         $bib_hash->{'biblioitems.ean'} = $itemid;
 975         if ( $itemid =~ /^977/ ) {
 976             $bib_hash->{'biblioitems.issn'} = $itemid;
 977         }
 978     }
 979     for my $key ( keys %{$bib_hash} ) {
 980         if ( !defined $bib_hash->{$key} ) {
 981             delete $bib_hash->{$key};
 982         }
 983     }
 984     return TransformKohaToMarc($bib_hash);
 985
 986 }
 987
 988 sub _create_item_from_quote {
 989     my ( $item, $quote ) = @_;
 990     my $defalt_classification_source =
 991       C4::Context->preference('DefaultClassificationSource');
 992     my $item_hash = {
 993         cn_source  => $defalt_classification_source,
 994         notforloan => -1,
 995         cn_sort    => q{},
 996     };
 997     $item_hash->{booksellerid} = $quote->vendor_id;
 998     $item_hash->{price}        = $item_hash->{replacementprice} = $item->price;
 999     $item_hash->{itype}        = $item->girfield('stock_category');
1000     $item_hash->{location}     = $item->girfield('collection_code');
1001
1002     my $note = {};
1003
1004     $item_hash->{itemcallnumber} =
1005          $item->girfield('shelfmark')
1006       || $item->girfield('classification')
1007       || title_level_class($item);
1008
1009     my $branch = $item->girfield('branch');
1010     $item_hash->{holdingbranch} = $item_hash->{homebranch} = $branch;
1011     return $item_hash;
1012 }
1013
1014 1;
1015 __END__
1016
1017 =head1 NAME
1018
1019 Koha::EDI
1020
1021 =head1 SYNOPSIS
1022
1023    Module exporting subroutines used in EDI processing for Koha
1024
1025 =head1 DESCRIPTION
1026
1027    Subroutines called by batch processing to handle Edifact
1028    messages of various types and related utilities
1029
1030 =head1 BUGS
1031
1032    These routines should really be methods of some object.
1033    get_edifact_ean is a stopgap which should be replaced
1034
1035 =head1 SUBROUTINES
1036
1037 =head2 process_quote
1038
1039     process_quote(quote_message);
1040
1041    passed a message object for a quote, parses it creating an order basket
1042    and orderlines in the database
1043    updates the message's status to received in the database and adds the
1044    link to basket
1045
1046 =head2 process_invoice
1047
1048     process_invoice(invoice_message)
1049
1050     passed a message object for an invoice, add the contained invoices
1051     and update the orderlines referred to in the invoice
1052     As an Edifact invoice is in effect a despatch note this receipts the
1053     appropriate quantities in the orders
1054
1055     no meaningful return value
1056
1057 =head2 process_ordrsp
1058
1059      process_ordrsp(ordrsp_message)
1060
1061      passed a message object for a supplier response, process the contents
1062      If an orderline is cancelled cancel the corresponding orderline in koha
1063      otherwise record the supplier message against it
1064
1065      no meaningful return value
1066
1067 =head2 create_edi_order
1068
1069     create_edi_order( { parameter_hashref } )
1070
1071     parameters must include basketno and ean
1072
1073     branchcode can optionally be passed
1074
1075     returns 1 on success undef otherwise
1076
1077     if the parameter noingest is set the formatted order is returned
1078     and not saved in the database. This functionality is intended for debugging only
1079
1080 =head2 receipt_items
1081
1082     receipt_items( schema_obj, invoice_line, ordernumber)
1083
1084     receipts the items recorded on this invoice line
1085
1086     no meaningful return
1087
1088 =head2 transfer_items
1089
1090     transfer_items(schema, invoice_line, originating_order, receiving_order)
1091
1092     Transfer the items covered by this invoice line from their original
1093     order to another order recording the partial fulfillment of the original
1094     order
1095
1096     no meaningful return
1097
1098 =head2 get_edifact_ean
1099
1100     $ean = get_edifact_ean();
1101
1102     routine to return the ean.
1103
1104 =head2 quote_item
1105
1106      quote_item(lineitem, quote_message);
1107
1108       Called by process_quote to handle an individual lineitem
1109      Generate the biblios and items if required and orderline linking to them
1110
1111      Returns 1 on success undef on error
1112
1113      Most usual cause of error is a line with no or incorrect budget codes
1114      which woild cause order creation to abort
1115      If other correct lines exist these are processed and the erroneous line os logged
1116
1117 =head2 title_level_class
1118
1119       classmark = title_level_class(edi_item)
1120
1121       Trys to return a title level classmark from a quote message line
1122       Will return a dewey or lcc classmark if one exists according to the
1123       value in DefaultClassificationSource syspref
1124
1125       If unable to returns the shelfmark or classification from the GIR segment
1126
1127       If all else fails returns empty string
1128
1129 =head2 _create_bib_from_quote
1130
1131        marc_record_obj = _create_bib_from_quote(lineitem, quote)
1132
1133        Returns a MARC::Record object based on the  info in the quote's lineitem
1134
1135 =head2 _create_item_from_quote
1136
1137        item_hashref = _create_item_from_quote( lineitem, quote)
1138
1139        returns a hashref representing the item fields specified in the quote
1140
1141 =head2 _get_invoiced_price
1142
1143       _get_invoiced_price(line_object)
1144
1145       Returns the net price or an equivalent calculated from line cost / qty
1146
1147 =head2 _discounted_price
1148
1149       ecost = _discounted_price(discount, item_price)
1150
1151       utility subroutine to return a price calculated from the
1152       vendors discount and quoted price
1153
1154 =head2 _check_for_existing_bib
1155
1156      (biblionumber, biblioitemnumber) = _check_for_existing_bib(isbn_or_ean)
1157
1158      passed an isbn or ean attempts to locate a match bib
1159      On success returns biblionumber and biblioitemnumber
1160      On failure returns undefined/an empty list
1161
1162 =head2 _get_budget
1163
1164      b = _get_budget(schema_obj, budget_code)
1165
1166      Returns the Aqbudget object for the active budget given the passed budget_code
1167      or undefined if one does not exist
1168
1169 =head1 AUTHOR
1170
1171    Colin Campbell <colin.campbell@ptfs-europe.com>
1172
1173
1174 =head1 COPYRIGHT
1175
1176    Copyright 2014,2015 PTFS-Europe Ltd
1177    This program is free software, You may redistribute it under
1178    under the terms of the GNU General Public License
1179
1180
1181 =cut