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         }
 481     }
 482
 483     my $gir_occurrence = 0;
 484     while ( $gir_occurrence < $quantity ) {
 485         my $branch = $inv_line->girfield( 'branch', $gir_occurrence );
 486         my $item = shift @{ $branch_map{$branch} };
 487         if ($item) {
 488             my $barcode = $inv_line->girfield( 'barcode', $gir_occurrence );
 489             if ( $barcode && !$item->barcode ) {
 490                 my $rs = $schema->resultset('Item')->search(
 491                     {
 492                         barcode => $barcode,
 493                     }
 494                 );
 495                 if ( $rs->count > 0 ) {
 496                     $logger->warn("Barcode $barcode is a duplicate");
 497                 }
 498                 else {
 499
 500                     $logger->trace("Adding barcode $barcode");
 501                     $item->barcode($barcode);
 502                 }
 503             }
 504
 505             # Handling for 'AcqItemSetSubfieldsWhenReceived'
 506             if (@affects) {
 507                 my $item_marc = C4::Items::GetMarcItem( $biblionumber, $item->itemnumber );
 508                 for my $affect (@affects) {
 509                     my ( $sf, $v ) = split q{=}, $affect, 2;
 510                     foreach ( $item_marc->field($itemfield) ) {
 511                         $_->update( $sf => $v );
 512                     }
 513                 }
 514                 C4::Items::ModItemFromMarc( $item_marc, $biblionumber, $item->itemnumber );
 515             }
 516
 517             $item->update;
 518         }
 519         else {
 520             $logger->warn("Unmatched item at branch:$branch");
 521         }
 522         ++$gir_occurrence;
 523     }
 524     return;
 525
 526 }
 527
 528 sub transfer_items {
 529     my ( $schema, $inv_line, $order_from, $order_to, $quantity ) = @_;
 530
 531     # Transfer x items from the orig order to a completed partial order
 532     my $gocc     = 0;
 533     my %mapped_by_branch;
 534     while ( $gocc < $quantity ) {
 535         my $branch = $inv_line->girfield( 'branch', $gocc );
 536         if ( !exists $mapped_by_branch{$branch} ) {
 537             $mapped_by_branch{$branch} = 1;
 538         }
 539         else {
 540             $mapped_by_branch{$branch}++;
 541         }
 542         ++$gocc;
 543     }
 544     my $logger = Log::Log4perl->get_logger();
 545     my $o1     = $order_from->ordernumber;
 546     my $o2     = $order_to->ordernumber;
 547     $logger->warn("transferring $quantity copies from order $o1 to order $o2");
 548
 549     my @item_links = $schema->resultset('AqordersItem')->search(
 550         {
 551             ordernumber => $order_from->ordernumber,
 552         }
 553     );
 554     foreach my $ilink (@item_links) {
 555         my $ino      = $ilink->itemnumber;
 556         my $item     = $schema->resultset('Item')->find( $ilink->itemnumber );
 557         my $i_branch = $item->get_column('homebranch');
 558         if ( exists $mapped_by_branch{$i_branch}
 559             && $mapped_by_branch{$i_branch} > 0 )
 560         {
 561             $ilink->ordernumber( $order_to->ordernumber );
 562             $ilink->update;
 563             --$quantity;
 564             --$mapped_by_branch{$i_branch};
 565             $logger->warn("Transferred item " . $item->itemnumber);
 566         }
 567         else {
 568             $logger->warn("Skipped item " . $item->itemnumber);
 569         }
 570         if ( $quantity < 1 ) {
 571             last;
 572         }
 573     }
 574
 575     return;
 576 }
 577
 578 sub process_quote {
 579     my $quote = shift;
 580
 581     $quote->status('processing');
 582     $quote->update;
 583
 584     my $edi = Koha::Edifact->new( { transmission => $quote->raw_msg, } );
 585
 586     my $messages       = $edi->message_array();
 587     my $process_errors = 0;
 588     my $logger         = Log::Log4perl->get_logger();
 589     my $schema         = Koha::Database->new()->schema();
 590     my $message_count  = 0;
 591     my @added_baskets;    # if auto & multiple baskets need to order all
 592
 593     if ( @{$messages} && $quote->vendor_id ) {
 594         foreach my $msg ( @{$messages} ) {
 595             ++$message_count;
 596             my $basketno =
 597               NewBasket( $quote->vendor_id, 0, $quote->filename, q{},
 598                 q{} . q{} );
 599             push @added_baskets, $basketno;
 600             if ( $message_count > 1 ) {
 601                 my $m_filename = $quote->filename;
 602                 $m_filename .= "_$message_count";
 603                 $schema->resultset('EdifactMessage')->create(
 604                     {
 605                         message_type  => $quote->message_type,
 606                         transfer_date => $quote->transfer_date,
 607                         vendor_id     => $quote->vendor_id,
 608                         edi_acct      => $quote->edi_acct,
 609                         status        => 'recmsg',
 610                         basketno      => $basketno,
 611                         raw_msg       => q{},
 612                         filename      => $m_filename,
 613                     }
 614                 );
 615             }
 616             else {
 617                 $quote->basketno($basketno);
 618             }
 619             $logger->trace("Created basket :$basketno");
 620             my $items  = $msg->lineitems();
 621             my $refnum = $msg->message_refno;
 622
 623             for my $item ( @{$items} ) {
 624                 if ( !quote_item( $item, $quote, $basketno ) ) {
 625                     ++$process_errors;
 626                 }
 627             }
 628         }
 629     }
 630     my $status = 'received';
 631     if ($process_errors) {
 632         $status = 'error';
 633     }
 634
 635     $quote->status($status);
 636     $quote->update;    # status and basketno link
 637                        # Do we automatically generate orders for this vendor
 638     my $v = $schema->resultset('VendorEdiAccount')->search(
 639         {
 640             vendor_id => $quote->vendor_id,
 641         }
 642     )->single;
 643     if ( $v->auto_orders ) {
 644         for my $b (@added_baskets) {
 645             create_edi_order(
 646                 {
 647                     ean      => $messages->[0]->buyer_ean,
 648                     basketno => $b,
 649                 }
 650             );
 651             Koha::Acquisition::Baskets->find($b)->close;
 652             # Log the approval
 653             if (C4::Context->preference("AcquisitionLog")) {
 654                 my $approved = Koha::Acquisition::Baskets->find( $b );
 655                 logaction(
 656                     'ACQUISITIONS',
 657                     'APPROVE_BASKET',
 658                     $b,
 659                     to_json($approved->unblessed)
 660                 );
 661             }
 662         }
 663     }
 664
 665
 666     return;
 667 }
 668
 669 sub quote_item {
 670     my ( $item, $quote, $basketno ) = @_;
 671
 672     my $schema = Koha::Database->new()->schema();
 673     my $logger = Log::Log4perl->get_logger();
 674
 675     # $basketno is the return from AddBasket in the calling routine
 676     # So this call should not fail unless that has
 677     my $basket = Koha::Acquisition::Baskets->find( $basketno );
 678     unless ( $basket ) {
 679         $logger->error('Skipping order creation no valid basketno');
 680         return;
 681     }
 682     $logger->trace( 'Checking db for matches with ', $item->item_number_id() );
 683     my $bib = _check_for_existing_bib( $item->item_number_id() );
 684     if ( !defined $bib ) {
 685         $bib = {};
 686         my $bib_record = _create_bib_from_quote( $item, $quote );
 687         ( $bib->{biblionumber}, $bib->{biblioitemnumber} ) =
 688           AddBiblio( $bib_record, q{} );
 689         $logger->trace("New biblio added $bib->{biblionumber}");
 690     }
 691     else {
 692         $logger->trace("Match found: $bib->{biblionumber}");
 693     }
 694
 695     # Create an orderline
 696     my $order_note = $item->{orderline_free_text};
 697     $order_note ||= q{};
 698     my $order_quantity = $item->quantity();
 699     my $gir_count      = $item->number_of_girs();
 700     $order_quantity ||= 1;    # quantity not necessarily present
 701     if ( $gir_count > 1 ) {
 702         if ( $gir_count != $order_quantity ) {
 703             $logger->error(
 704                 "Order for $order_quantity items, $gir_count segments present");
 705         }
 706         $order_quantity = 1;    # attempts to create an orderline for each gir
 707     }
 708     my $price  = $item->price_info;
 709     # Howells do not send an info price but do have a gross price
 710     if (!$price) {
 711         $price = $item->price_gross;
 712     }
 713     my $vendor = Koha::Acquisition::Booksellers->find( $quote->vendor_id );
 714
 715     # NB quote will not include tax info it only contains the list price
 716     my $ecost = _discounted_price( $vendor->discount, $price, $item->price_info_inclusive );
 717
 718     # database definitions should set some of these defaults but dont
 719     my $order_hash = {
 720         biblionumber       => $bib->{biblionumber},
 721         entrydate          => dt_from_string()->ymd(),
 722         basketno           => $basketno,
 723         listprice          => $price,
 724         quantity           => $order_quantity,
 725         quantityreceived   => 0,
 726         order_vendornote   => q{},
 727         order_internalnote => q{},
 728         replacementprice   => $price,
 729         rrp_tax_included   => $price,
 730         rrp_tax_excluded   => $price,
 731         rrp                => $price,
 732         ecost              => $ecost,
 733         ecost_tax_included => $ecost,
 734         ecost_tax_excluded => $ecost,
 735         uncertainprice     => 0,
 736         sort1              => q{},
 737         sort2              => q{},
 738         currency           => $vendor->listprice(),
 739     };
 740
 741     # suppliers references
 742     if ( $item->reference() ) {
 743         $order_hash->{suppliers_reference_number}    = $item->reference;
 744         $order_hash->{suppliers_reference_qualifier} = 'QLI';
 745     }
 746     elsif ( $item->orderline_reference_number() ) {
 747         $order_hash->{suppliers_reference_number} =
 748           $item->orderline_reference_number;
 749         $order_hash->{suppliers_reference_qualifier} = 'SLI';
 750     }
 751     if ( $item->item_number_id ) {    # suppliers ean
 752         $order_hash->{line_item_id} = $item->item_number_id;
 753     }
 754
 755     if ( $item->girfield('servicing_instruction') ) {
 756         my $occ = 0;
 757         my $txt = q{};
 758         my $si;
 759         while ( $si = $item->girfield( 'servicing_instruction', $occ ) ) {
 760             if ($occ) {
 761                 $txt .= q{: };
 762             }
 763             $txt .= $si;
 764             ++$occ;
 765         }
 766     }
 767     if ($order_note) {
 768         $order_hash->{order_vendornote} = $order_note;
 769     }
 770
 771     if ( $item->internal_notes() ) {
 772         if ( $order_hash->{order_internalnote} ) {    # more than ''
 773             $order_hash->{order_internalnote} .= q{ };
 774         }
 775         $order_hash->{order_internalnote} .= $item->internal_notes;
 776     }
 777
 778     my $budget = _get_budget( $schema, $item->girfield('fund_allocation') );
 779
 780     my $skip = '0';
 781     if ( !$budget ) {
 782         if ( $item->quantity > 1 ) {
 783             carp 'Skipping line with no budget info';
 784             $logger->trace('girfield skipped for invalid budget');
 785             $skip++;
 786         }
 787         else {
 788             carp 'Skipping line with no budget info';
 789             $logger->trace('orderline skipped for invalid budget');
 790             return;
 791         }
 792     }
 793
 794     my %ordernumber;
 795     my %budgets;
 796     my $item_hash;
 797
 798     if ( !$skip ) {
 799         $order_hash->{budget_id} = $budget->budget_id;
 800         my $first_order = $schema->resultset('Aqorder')->create($order_hash);
 801         my $o           = $first_order->ordernumber();
 802         $logger->trace("Order created :$o");
 803
 804         # should be done by database settings
 805         $first_order->parent_ordernumber( $first_order->ordernumber() );
 806         $first_order->update();
 807
 808         # add to $budgets to prevent duplicate orderlines
 809         $budgets{ $budget->budget_id } = '1';
 810
 811         # record ordernumber against budget
 812         $ordernumber{ $budget->budget_id } = $o;
 813
 814         if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
 815             $item_hash = _create_item_from_quote( $item, $quote );
 816
 817             my $created = 0;
 818             while ( $created < $order_quantity ) {
 819                 $item_hash->{biblionumber} = $bib->{biblionumber};
 820                 $item_hash->{biblioitemnumber} = $bib->{biblioitemnumber};
 821                 my $kitem = Koha::Item->new( $item_hash )->store;
 822                 my $itemnumber = $kitem->itemnumber;
 823                 $logger->trace("Added item:$itemnumber");
 824                 $schema->resultset('AqordersItem')->create(
 825                     {
 826                         ordernumber => $first_order->ordernumber,
 827                         itemnumber  => $itemnumber,
 828                     }
 829                 );
 830                 ++$created;
 831
 832                 my $lrp = $item->girfield('library_rotation_plan');
 833                 if ($lrp) {
 834                     my $rota = Koha::StockRotationRotas->find(
 835                         { title => $lrp },
 836                         { key   => 'stockrotationrotas_title' }
 837                     );
 838                     if ($rota) {
 839                         $rota->add_item($itemnumber);
 840                         $logger->trace("Item added to rota $rota->id");
 841                     } else {
 842                         $logger->error("No rota found matching $lrp in orderline");
 843                     }
 844                 }
 845             }
 846         }
 847     }
 848
 849     if ( $order_quantity == 1 && $item->quantity > 1 ) {
 850         my $occurrence = 1;    # occ zero already added
 851         while ( $occurrence < $item->quantity ) {
 852
 853             # check budget code
 854             $budget = _get_budget( $schema,
 855                 $item->girfield( 'fund_allocation', $occurrence ) );
 856
 857             if ( !$budget ) {
 858                 my $bad_budget =
 859                   $item->girfield( 'fund_allocation', $occurrence );
 860                 carp 'Skipping line with no budget info';
 861                 $logger->trace(
 862                     "girfield skipped for invalid budget:$bad_budget");
 863                 ++$occurrence;    ## lets look at the next one not this one again
 864                 next;
 865             }
 866
 867             # add orderline for NEW budget in $budgets
 868             if ( !exists $budgets{ $budget->budget_id } ) {
 869
 870                 # $order_hash->{quantity} = 1; by default above
 871                 # we should handle both 1:1 GIR & 1:n GIR (with LQT values) here
 872
 873                 $order_hash->{budget_id} = $budget->budget_id;
 874
 875                 my $new_order =
 876                   $schema->resultset('Aqorder')->create($order_hash);
 877                 my $o = $new_order->ordernumber();
 878                 $logger->trace("Order created :$o");
 879
 880                 # should be done by database settings
 881                 $new_order->parent_ordernumber( $new_order->ordernumber() );
 882                 $new_order->update();
 883
 884                 # add to $budgets to prevent duplicate orderlines
 885                 $budgets{ $budget->budget_id } = '1';
 886
 887                 # record ordernumber against budget
 888                 $ordernumber{ $budget->budget_id } = $o;
 889
 890                 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
 891                     if ( !defined $item_hash ) {
 892                         $item_hash = _create_item_from_quote( $item, $quote );
 893                     }
 894                     my $new_item = {
 895                         itype =>
 896                           $item->girfield( 'stock_category', $occurrence ),
 897                         itemcallnumber =>
 898                           $item->girfield( 'shelfmark', $occurrence )
 899                           || $item->girfield( 'classification', $occurrence )
 900                           || title_level_class($item),
 901                         holdingbranch =>
 902                           $item->girfield( 'branch', $occurrence ),
 903                         homebranch => $item->girfield( 'branch', $occurrence ),
 904                     };
 905
 906                     my $lsq_field = C4::Context->preference('EdifactLSQ');
 907                     $new_item->{$lsq_field} = $item->girfield( 'sequence_code', $occurrence );
 908
 909                     if ( $new_item->{itype} ) {
 910                         $item_hash->{itype} = $new_item->{itype};
 911                     }
 912                     if ( $new_item->{$lsq_field} ) {
 913                         $item_hash->{$lsq_field} = $new_item->{$lsq_field};
 914                     }
 915                     if ( $new_item->{itemcallnumber} ) {
 916                         $item_hash->{itemcallnumber} =
 917                           $new_item->{itemcallnumber};
 918                     }
 919                     if ( $new_item->{holdingbranch} ) {
 920                         $item_hash->{holdingbranch} =
 921                           $new_item->{holdingbranch};
 922                     }
 923                     if ( $new_item->{homebranch} ) {
 924                         $item_hash->{homebranch} = $new_item->{homebranch};
 925                     }
 926
 927                     $item_hash->{biblionumber} = $bib->{biblionumber};
 928                     $item_hash->{biblioitemnumber} = $bib->{biblioitemnumber};
 929                     my $kitem = Koha::Item->new( $item_hash )->store;
 930                     my $itemnumber = $kitem->itemnumber;
 931                     $logger->trace("New item $itemnumber added");
 932                     $schema->resultset('AqordersItem')->create(
 933                         {
 934                             ordernumber => $new_order->ordernumber,
 935                             itemnumber  => $itemnumber,
 936                         }
 937                     );
 938
 939                     my $lrp =
 940                       $item->girfield( 'library_rotation_plan', $occurrence );
 941                     if ($lrp) {
 942                         my $rota =
 943                           Koha::StockRotationRotas->find( { title => $lrp },
 944                             { key => 'stockrotationrotas_title' } );
 945                         if ($rota) {
 946                             $rota->add_item($itemnumber);
 947                             $logger->trace("Item added to rota $rota->id");
 948                         }
 949                         else {
 950                             $logger->error(
 951                                 "No rota found matching $lrp in orderline");
 952                         }
 953                     }
 954                 }
 955
 956                 ++$occurrence;
 957             }
 958
 959             # increment quantity in orderline for EXISTING budget in $budgets
 960             else {
 961                 my $row = $schema->resultset('Aqorder')->find(
 962                     {
 963                         ordernumber => $ordernumber{ $budget->budget_id }
 964                     }
 965                 );
 966                 if ($row) {
 967                     my $qty = $row->quantity;
 968                     $qty++;
 969                     $row->update(
 970                         {
 971                             quantity => $qty,
 972                         }
 973                     );
 974                 }
 975
 976                 # Do not use the basket level value as it is always NULL
 977                 # See calling subs call to AddBasket
 978                 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
 979                     my $new_item = {
 980                         notforloan       => -1,
 981                         cn_sort          => q{},
 982                         cn_source        => 'ddc',
 983                         price            => $price,
 984                         replacementprice => $price,
 985                         itype =>
 986                           $item->girfield( 'stock_category', $occurrence ),
 987                         itemcallnumber =>
 988                           $item->girfield( 'shelfmark', $occurrence )
 989                           || $item->girfield( 'classification', $occurrence )
 990                           || $item_hash->{itemcallnumber},
 991                         holdingbranch =>
 992                           $item->girfield( 'branch', $occurrence ),
 993                         homebranch => $item->girfield( 'branch', $occurrence ),
 994                     };
 995                     my $lsq_field = C4::Context->preference('EdifactLSQ');
 996                     $new_item->{$lsq_field} = $item->girfield( 'sequence_code', $occurrence );
 997                     $new_item->{biblionumber} = $bib->{biblionumber};
 998                     $new_item->{biblioitemnumber} = $bib->{biblioitemnumber};
 999                     my $kitem = Koha::Item->new( $new_item )->store;
1000                     my $itemnumber = $kitem->itemnumber;
1001                     $logger->trace("New item $itemnumber added");
1002                     $schema->resultset('AqordersItem')->create(
1003                         {
1004                             ordernumber => $ordernumber{ $budget->budget_id },
1005                             itemnumber  => $itemnumber,
1006                         }
1007                     );
1008
1009                     my $lrp =
1010                       $item->girfield( 'library_rotation_plan', $occurrence );
1011                     if ($lrp) {
1012                         my $rota =
1013                           Koha::StockRotationRotas->find( { title => $lrp },
1014                             { key => 'stockrotationrotas_title' } );
1015                         if ($rota) {
1016                             $rota->add_item($itemnumber);
1017                             $logger->trace("Item added to rota $rota->id");
1018                         }
1019                         else {
1020                             $logger->error(
1021                                 "No rota found matching $lrp in orderline");
1022                         }
1023                     }
1024                 }
1025
1026                 ++$occurrence;
1027             }
1028         }
1029     }
1030     return 1;
1031
1032 }
1033
1034 sub get_edifact_ean {
1035
1036     my $dbh = C4::Context->dbh;
1037
1038     my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean');
1039
1040     return $eans->[0];
1041 }
1042
1043 # We should not need to have a routine to do this here
1044 sub _discounted_price {
1045     my ( $discount, $price, $discounted_price ) = @_;
1046     if (defined $discounted_price) {
1047         return $discounted_price;
1048     }
1049     if (!$price) {
1050         return 0;
1051     }
1052     return $price - ( ( $discount * $price ) / 100 );
1053 }
1054
1055 sub _check_for_existing_bib {
1056     my $isbn = shift;
1057
1058     my $search_isbn = $isbn;
1059     $search_isbn =~ s/^\s*/%/xms;
1060     $search_isbn =~ s/\s*$/%/xms;
1061     my $dbh = C4::Context->dbh;
1062     my $sth = $dbh->prepare(
1063 'select biblionumber, biblioitemnumber from biblioitems where isbn like ?',
1064     );
1065     my $tuple_arr =
1066       $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
1067     if ( @{$tuple_arr} ) {
1068         return $tuple_arr->[0];
1069     }
1070     elsif ( length($isbn) == 13 && $isbn !~ /^97[89]/ ) {
1071         my $tarr = $dbh->selectall_arrayref(
1072 'select biblionumber, biblioitemnumber from biblioitems where ean = ?',
1073             { Slice => {} },
1074             $isbn
1075         );
1076         if ( @{$tarr} ) {
1077             return $tarr->[0];
1078         }
1079     }
1080     else {
1081         undef $search_isbn;
1082         $isbn =~ s/\-//xmsg;
1083         if ( $isbn =~ m/(\d{13})/xms ) {
1084             my $b_isbn = Business::ISBN->new($1);
1085             if ( $b_isbn && $b_isbn->is_valid && $b_isbn->as_isbn10 ) {
1086                 $search_isbn = $b_isbn->as_isbn10->as_string( [] );
1087             }
1088
1089         }
1090         elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) {
1091             my $b_isbn = Business::ISBN->new($1);
1092             if ( $b_isbn && $b_isbn->is_valid ) {
1093                 $search_isbn = $b_isbn->as_isbn13->as_string( [] );
1094             }
1095
1096         }
1097         if ($search_isbn) {
1098             $search_isbn = "%$search_isbn%";
1099             $tuple_arr =
1100               $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
1101             if ( @{$tuple_arr} ) {
1102                 return $tuple_arr->[0];
1103             }
1104         }
1105     }
1106     return;
1107 }
1108
1109 # returns a budget obj or undef
1110 # fact we need this shows what a mess Acq API is
1111 sub _get_budget {
1112     my ( $schema, $budget_code ) = @_;
1113     my $period_rs = $schema->resultset('Aqbudgetperiod')->search(
1114         {
1115             budget_period_active => 1,
1116         }
1117     );
1118
1119     # db does not ensure budget code is unque
1120     return $schema->resultset('Aqbudget')->single(
1121         {
1122             budget_code => $budget_code,
1123             budget_period_id =>
1124               { -in => $period_rs->get_column('budget_period_id')->as_query },
1125         }
1126     );
1127 }
1128
1129 # try to get title level classification from incoming quote
1130 sub title_level_class {
1131     my ($item)         = @_;
1132     my $class          = q{};
1133     my $default_scheme = C4::Context->preference('DefaultClassificationSource');
1134     if ( $default_scheme eq 'ddc' ) {
1135         $class = $item->dewey_class();
1136     }
1137     elsif ( $default_scheme eq 'lcc' ) {
1138         $class = $item->lc_class();
1139     }
1140     if ( !$class ) {
1141         $class =
1142              $item->girfield('shelfmark')
1143           || $item->girfield('classification')
1144           || q{};
1145     }
1146     return $class;
1147 }
1148
1149 sub _create_bib_from_quote {
1150
1151     #TBD we should flag this for updating from an external source
1152     #As biblio (&biblioitems) has no candidates flag in order
1153     my ( $item, $quote ) = @_;
1154     my $itemid = $item->item_number_id;
1155     my $defalt_classification_source =
1156       C4::Context->preference('DefaultClassificationSource');
1157     my $bib_hash = {
1158         'biblioitems.cn_source' => $defalt_classification_source,
1159         'items.cn_source'       => $defalt_classification_source,
1160         'items.notforloan'      => -1,
1161         'items.cn_sort'         => q{},
1162     };
1163     $bib_hash->{'biblio.seriestitle'} = $item->series;
1164
1165     $bib_hash->{'biblioitems.publishercode'} = $item->publisher;
1166     $bib_hash->{'biblioitems.publicationyear'} =
1167       $bib_hash->{'biblio.copyrightdate'} = $item->publication_date;
1168
1169     $bib_hash->{'biblio.title'}         = $item->title;
1170     $bib_hash->{'biblio.author'}        = $item->author;
1171     $bib_hash->{'biblioitems.isbn'}     = $item->item_number_id;
1172     $bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category');
1173
1174     # If we have a 13 digit id we are assuming its an ean
1175     # (it may also be an isbn or issn)
1176     if ( $itemid =~ /^\d{13}$/ ) {
1177         $bib_hash->{'biblioitems.ean'} = $itemid;
1178         if ( $itemid =~ /^977/ ) {
1179             $bib_hash->{'biblioitems.issn'} = $itemid;
1180         }
1181     }
1182     for my $key ( keys %{$bib_hash} ) {
1183         if ( !defined $bib_hash->{$key} ) {
1184             delete $bib_hash->{$key};
1185         }
1186     }
1187     return TransformKohaToMarc($bib_hash);
1188
1189 }
1190
1191 sub _create_item_from_quote {
1192     my ( $item, $quote ) = @_;
1193     my $defalt_classification_source =
1194       C4::Context->preference('DefaultClassificationSource');
1195     my $item_hash = {
1196         cn_source  => $defalt_classification_source,
1197         notforloan => -1,
1198         cn_sort    => q{},
1199     };
1200     $item_hash->{booksellerid} = $quote->vendor_id;
1201     $item_hash->{price}        = $item_hash->{replacementprice} = $item->price;
1202     $item_hash->{itype}        = $item->girfield('stock_category');
1203     my $lsq_field = C4::Context->preference('EdifactLSQ');
1204     $item_hash->{$lsq_field}     = $item->girfield('sequence_code');
1205
1206     my $note = {};
1207
1208     $item_hash->{itemcallnumber} =
1209          $item->girfield('shelfmark')
1210       || $item->girfield('classification')
1211       || title_level_class($item);
1212
1213     my $branch = $item->girfield('branch');
1214     $item_hash->{holdingbranch} = $item_hash->{homebranch} = $branch;
1215     return $item_hash;
1216 }
1217
1218 1;
1219 __END__
1220
1221 =head1 NAME
1222
1223 Koha::EDI
1224
1225 =head1 SYNOPSIS
1226
1227    Module exporting subroutines used in EDI processing for Koha
1228
1229 =head1 DESCRIPTION
1230
1231    Subroutines called by batch processing to handle Edifact
1232    messages of various types and related utilities
1233
1234 =head1 BUGS
1235
1236    These routines should really be methods of some object.
1237    get_edifact_ean is a stopgap which should be replaced
1238
1239 =head1 SUBROUTINES
1240
1241 =head2 process_quote
1242
1243     process_quote(quote_message);
1244
1245    passed a message object for a quote, parses it creating an order basket
1246    and orderlines in the database
1247    updates the message's status to received in the database and adds the
1248    link to basket
1249
1250 =head2 process_invoice
1251
1252     process_invoice(invoice_message)
1253
1254     passed a message object for an invoice, add the contained invoices
1255     and update the orderlines referred to in the invoice
1256     As an Edifact invoice is in effect a despatch note this receipts the
1257     appropriate quantities in the orders
1258
1259     no meaningful return value
1260
1261 =head2 process_ordrsp
1262
1263      process_ordrsp(ordrsp_message)
1264
1265      passed a message object for a supplier response, process the contents
1266      If an orderline is cancelled cancel the corresponding orderline in koha
1267      otherwise record the supplier message against it
1268
1269      no meaningful return value
1270
1271 =head2 create_edi_order
1272
1273     create_edi_order( { parameter_hashref } )
1274
1275     parameters must include basketno and ean
1276
1277     branchcode can optionally be passed
1278
1279     returns 1 on success undef otherwise
1280
1281     if the parameter noingest is set the formatted order is returned
1282     and not saved in the database. This functionality is intended for debugging only
1283
1284 =head2 receipt_items
1285
1286     receipt_items( schema_obj, invoice_line, ordernumber, $quantity)
1287
1288     receipts the items recorded on this invoice line
1289
1290     no meaningful return
1291
1292 =head2 transfer_items
1293
1294     transfer_items(schema, invoice_line, originating_order, receiving_order, $quantity)
1295
1296     Transfer the items covered by this invoice line from their original
1297     order to another order recording the partial fulfillment of the original
1298     order
1299
1300     no meaningful return
1301
1302 =head2 get_edifact_ean
1303
1304     $ean = get_edifact_ean();
1305
1306     routine to return the ean.
1307
1308 =head2 quote_item
1309
1310      quote_item(lineitem, quote_message);
1311
1312       Called by process_quote to handle an individual lineitem
1313      Generate the biblios and items if required and orderline linking to them
1314
1315      Returns 1 on success undef on error
1316
1317      Most usual cause of error is a line with no or incorrect budget codes
1318      which woild cause order creation to abort
1319      If other correct lines exist these are processed and the erroneous line os logged
1320
1321 =head2 title_level_class
1322
1323       classmark = title_level_class(edi_item)
1324
1325       Trys to return a title level classmark from a quote message line
1326       Will return a dewey or lcc classmark if one exists according to the
1327       value in DefaultClassificationSource syspref
1328
1329       If unable to returns the shelfmark or classification from the GIR segment
1330
1331       If all else fails returns empty string
1332
1333 =head2 _create_bib_from_quote
1334
1335        marc_record_obj = _create_bib_from_quote(lineitem, quote)
1336
1337        Returns a MARC::Record object based on the  info in the quote's lineitem
1338
1339 =head2 _create_item_from_quote
1340
1341        item_hashref = _create_item_from_quote( lineitem, quote)
1342
1343        returns a hashref representing the item fields specified in the quote
1344
1345 =head2 _get_invoiced_price
1346
1347       (price, price_tax_excluded) = _get_invoiced_price(line_object, $quantity)
1348
1349       Returns an array of unitprice and unitprice_tax_excluded derived from the lineitem
1350       monetary fields
1351
1352 =head2 _discounted_price
1353
1354       ecost = _discounted_price(discount, item_price, discounted_price)
1355
1356       utility subroutine to return a price calculated from the
1357       vendors discount and quoted price
1358       if invoice has a field containing discounted price that is returned
1359       instead of recalculating
1360
1361 =head2 _check_for_existing_bib
1362
1363      (biblionumber, biblioitemnumber) = _check_for_existing_bib(isbn_or_ean)
1364
1365      passed an isbn or ean attempts to locate a match bib
1366      On success returns biblionumber and biblioitemnumber
1367      On failure returns undefined/an empty list
1368
1369 =head2 _get_budget
1370
1371      b = _get_budget(schema_obj, budget_code)
1372
1373      Returns the Aqbudget object for the active budget given the passed budget_code
1374      or undefined if one does not exist
1375
1376 =head1 AUTHOR
1377
1378    Colin Campbell <colin.campbell@ptfs-europe.com>
1379
1380
1381 =head1 COPYRIGHT
1382
1383    Copyright 2014,2015 PTFS-Europe Ltd
1384    This program is free software, You may redistribute it under
1385    under the terms of the GNU General Public License
1386
1387
1388 =cut