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