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