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