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