Koha/EDI.pm

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