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