Koha/EDI.pm

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