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