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