Koha/EDI.pm

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