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->get_column('homebranch');
 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->get_column('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                         itemcallnumber =>
 873                           $item->girfield( 'shelfmark', $occurrence )
 874                           || $item->girfield( 'classification', $occurrence )
 875                           || title_level_class($item),
 876                         holdingbranch =>
 877                           $item->girfield( 'branch', $occurrence ),
 878                         homebranch => $item->girfield( 'branch', $occurrence ),
 879                     };
 880
 881                     my $lsq_field = C4::Context->preference('EdifactLSQ');
 882                     $new_item->{$lsq_field} = $item->girfield( 'sequence_code', $occurrence );
 883
 884                     if ( $new_item->{itype} ) {
 885                         $item_hash->{itype} = $new_item->{itype};
 886                     }
 887                     if ( $new_item->{$lsq_field} ) {
 888                         $item_hash->{$lsq_field} = $new_item->{$lsq_field};
 889                     }
 890                     if ( $new_item->{itemcallnumber} ) {
 891                         $item_hash->{itemcallnumber} =
 892                           $new_item->{itemcallnumber};
 893                     }
 894                     if ( $new_item->{holdingbranch} ) {
 895                         $item_hash->{holdingbranch} =
 896                           $new_item->{holdingbranch};
 897                     }
 898                     if ( $new_item->{homebranch} ) {
 899                         $item_hash->{homebranch} = $new_item->{homebranch};
 900                     }
 901
 902                     $item_hash->{biblionumber} = $bib->{biblionumber};
 903                     $item_hash->{biblioitemnumber} = $bib->{biblioitemnumber};
 904                     my $kitem = Koha::Item->new( $item_hash )->store;
 905                     my $itemnumber = $kitem->itemnumber;
 906                     $logger->trace("New item $itemnumber added");
 907                     $schema->resultset('AqordersItem')->create(
 908                         {
 909                             ordernumber => $new_order->ordernumber,
 910                             itemnumber  => $itemnumber,
 911                         }
 912                     );
 913
 914                     my $lrp =
 915                       $item->girfield( 'library_rotation_plan', $occurrence );
 916                     if ($lrp) {
 917                         my $rota =
 918                           Koha::StockRotationRotas->find( { title => $lrp },
 919                             { key => 'stockrotationrotas_title' } );
 920                         if ($rota) {
 921                             $rota->add_item($itemnumber);
 922                             $logger->trace("Item added to rota $rota->id");
 923                         }
 924                         else {
 925                             $logger->error(
 926                                 "No rota found matching $lrp in orderline");
 927                         }
 928                     }
 929                 }
 930
 931                 ++$occurrence;
 932             }
 933
 934             # increment quantity in orderline for EXISTING budget in $budgets
 935             else {
 936                 my $row = $schema->resultset('Aqorder')->find(
 937                     {
 938                         ordernumber => $ordernumber{ $budget->budget_id }
 939                     }
 940                 );
 941                 if ($row) {
 942                     my $qty = $row->quantity;
 943                     $qty++;
 944                     $row->update(
 945                         {
 946                             quantity => $qty,
 947                         }
 948                     );
 949                 }
 950
 951                 # Do not use the basket level value as it is always NULL
 952                 # See calling subs call to AddBasket
 953                 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
 954                     my $new_item = {
 955                         notforloan       => -1,
 956                         cn_sort          => q{},
 957                         cn_source        => 'ddc',
 958                         price            => $price,
 959                         replacementprice => $price,
 960                         itype =>
 961                           $item->girfield( 'stock_category', $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                     my $lsq_field = C4::Context->preference('EdifactLSQ');
 971                     $new_item->{$lsq_field} = $item->girfield( 'sequence_code', $occurrence );
 972                     $new_item->{biblionumber} = $bib->{biblionumber};
 973                     $new_item->{biblioitemnumber} = $bib->{biblioitemnumber};
 974                     my $kitem = Koha::Item->new( $new_item )->store;
 975                     my $itemnumber = $kitem->itemnumber;
 976                     $logger->trace("New item $itemnumber added");
 977                     $schema->resultset('AqordersItem')->create(
 978                         {
 979                             ordernumber => $ordernumber{ $budget->budget_id },
 980                             itemnumber  => $itemnumber,
 981                         }
 982                     );
 983
 984                     my $lrp =
 985                       $item->girfield( 'library_rotation_plan', $occurrence );
 986                     if ($lrp) {
 987                         my $rota =
 988                           Koha::StockRotationRotas->find( { title => $lrp },
 989                             { key => 'stockrotationrotas_title' } );
 990                         if ($rota) {
 991                             $rota->add_item($itemnumber);
 992                             $logger->trace("Item added to rota $rota->id");
 993                         }
 994                         else {
 995                             $logger->error(
 996                                 "No rota found matching $lrp in orderline");
 997                         }
 998                     }
 999                 }
1000
1001                 ++$occurrence;
1002             }
1003         }
1004     }
1005     return 1;
1006
1007 }
1008
1009 sub get_edifact_ean {
1010
1011     my $dbh = C4::Context->dbh;
1012
1013     my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean');
1014
1015     return $eans->[0];
1016 }
1017
1018 # We should not need to have a routine to do this here
1019 sub _discounted_price {
1020     my ( $discount, $price, $discounted_price ) = @_;
1021     if (defined $discounted_price) {
1022         return $discounted_price;
1023     }
1024     if (!$price) {
1025         return 0;
1026     }
1027     return $price - ( ( $discount * $price ) / 100 );
1028 }
1029
1030 sub _check_for_existing_bib {
1031     my $isbn = shift;
1032
1033     my $search_isbn = $isbn;
1034     $search_isbn =~ s/^\s*/%/xms;
1035     $search_isbn =~ s/\s*$/%/xms;
1036     my $dbh = C4::Context->dbh;
1037     my $sth = $dbh->prepare(
1038 'select biblionumber, biblioitemnumber from biblioitems where isbn like ?',
1039     );
1040     my $tuple_arr =
1041       $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
1042     if ( @{$tuple_arr} ) {
1043         return $tuple_arr->[0];
1044     }
1045     elsif ( length($isbn) == 13 && $isbn !~ /^97[89]/ ) {
1046         my $tarr = $dbh->selectall_arrayref(
1047 'select biblionumber, biblioitemnumber from biblioitems where ean = ?',
1048             { Slice => {} },
1049             $isbn
1050         );
1051         if ( @{$tarr} ) {
1052             return $tarr->[0];
1053         }
1054     }
1055     else {
1056         undef $search_isbn;
1057         $isbn =~ s/\-//xmsg;
1058         if ( $isbn =~ m/(\d{13})/xms ) {
1059             my $b_isbn = Business::ISBN->new($1);
1060             if ( $b_isbn && $b_isbn->is_valid && $b_isbn->as_isbn10 ) {
1061                 $search_isbn = $b_isbn->as_isbn10->as_string( [] );
1062             }
1063
1064         }
1065         elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) {
1066             my $b_isbn = Business::ISBN->new($1);
1067             if ( $b_isbn && $b_isbn->is_valid ) {
1068                 $search_isbn = $b_isbn->as_isbn13->as_string( [] );
1069             }
1070
1071         }
1072         if ($search_isbn) {
1073             $search_isbn = "%$search_isbn%";
1074             $tuple_arr =
1075               $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
1076             if ( @{$tuple_arr} ) {
1077                 return $tuple_arr->[0];
1078             }
1079         }
1080     }
1081     return;
1082 }
1083
1084 # returns a budget obj or undef
1085 # fact we need this shows what a mess Acq API is
1086 sub _get_budget {
1087     my ( $schema, $budget_code ) = @_;
1088     my $period_rs = $schema->resultset('Aqbudgetperiod')->search(
1089         {
1090             budget_period_active => 1,
1091         }
1092     );
1093
1094     # db does not ensure budget code is unque
1095     return $schema->resultset('Aqbudget')->single(
1096         {
1097             budget_code => $budget_code,
1098             budget_period_id =>
1099               { -in => $period_rs->get_column('budget_period_id')->as_query },
1100         }
1101     );
1102 }
1103
1104 # try to get title level classification from incoming quote
1105 sub title_level_class {
1106     my ($item)         = @_;
1107     my $class          = q{};
1108     my $default_scheme = C4::Context->preference('DefaultClassificationSource');
1109     if ( $default_scheme eq 'ddc' ) {
1110         $class = $item->dewey_class();
1111     }
1112     elsif ( $default_scheme eq 'lcc' ) {
1113         $class = $item->lc_class();
1114     }
1115     if ( !$class ) {
1116         $class =
1117              $item->girfield('shelfmark')
1118           || $item->girfield('classification')
1119           || q{};
1120     }
1121     return $class;
1122 }
1123
1124 sub _create_bib_from_quote {
1125
1126     #TBD we should flag this for updating from an external source
1127     #As biblio (&biblioitems) has no candidates flag in order
1128     my ( $item, $quote ) = @_;
1129     my $itemid = $item->item_number_id;
1130     my $defalt_classification_source =
1131       C4::Context->preference('DefaultClassificationSource');
1132     my $bib_hash = {
1133         'biblioitems.cn_source' => $defalt_classification_source,
1134         'items.cn_source'       => $defalt_classification_source,
1135         'items.notforloan'      => -1,
1136         'items.cn_sort'         => q{},
1137     };
1138     $bib_hash->{'biblio.seriestitle'} = $item->series;
1139
1140     $bib_hash->{'biblioitems.publishercode'} = $item->publisher;
1141     $bib_hash->{'biblioitems.publicationyear'} =
1142       $bib_hash->{'biblio.copyrightdate'} = $item->publication_date;
1143
1144     $bib_hash->{'biblio.title'}         = $item->title;
1145     $bib_hash->{'biblio.author'}        = $item->author;
1146     $bib_hash->{'biblioitems.isbn'}     = $item->item_number_id;
1147     $bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category');
1148
1149     # If we have a 13 digit id we are assuming its an ean
1150     # (it may also be an isbn or issn)
1151     if ( $itemid =~ /^\d{13}$/ ) {
1152         $bib_hash->{'biblioitems.ean'} = $itemid;
1153         if ( $itemid =~ /^977/ ) {
1154             $bib_hash->{'biblioitems.issn'} = $itemid;
1155         }
1156     }
1157     for my $key ( keys %{$bib_hash} ) {
1158         if ( !defined $bib_hash->{$key} ) {
1159             delete $bib_hash->{$key};
1160         }
1161     }
1162     return TransformKohaToMarc($bib_hash);
1163
1164 }
1165
1166 sub _create_item_from_quote {
1167     my ( $item, $quote ) = @_;
1168     my $defalt_classification_source =
1169       C4::Context->preference('DefaultClassificationSource');
1170     my $item_hash = {
1171         cn_source  => $defalt_classification_source,
1172         notforloan => -1,
1173         cn_sort    => q{},
1174     };
1175     $item_hash->{booksellerid} = $quote->vendor_id;
1176     $item_hash->{price}        = $item_hash->{replacementprice} = $item->price;
1177     $item_hash->{itype}        = $item->girfield('stock_category');
1178     my $lsq_field = C4::Context->preference('EdifactLSQ');
1179     $item_hash->{$lsq_field}     = $item->girfield('sequence_code');
1180
1181     my $note = {};
1182
1183     $item_hash->{itemcallnumber} =
1184          $item->girfield('shelfmark')
1185       || $item->girfield('classification')
1186       || title_level_class($item);
1187
1188     my $branch = $item->girfield('branch');
1189     $item_hash->{holdingbranch} = $item_hash->{homebranch} = $branch;
1190     return $item_hash;
1191 }
1192
1193 1;
1194 __END__
1195
1196 =head1 NAME
1197
1198 Koha::EDI
1199
1200 =head1 SYNOPSIS
1201
1202    Module exporting subroutines used in EDI processing for Koha
1203
1204 =head1 DESCRIPTION
1205
1206    Subroutines called by batch processing to handle Edifact
1207    messages of various types and related utilities
1208
1209 =head1 BUGS
1210
1211    These routines should really be methods of some object.
1212    get_edifact_ean is a stopgap which should be replaced
1213
1214 =head1 SUBROUTINES
1215
1216 =head2 process_quote
1217
1218     process_quote(quote_message);
1219
1220    passed a message object for a quote, parses it creating an order basket
1221    and orderlines in the database
1222    updates the message's status to received in the database and adds the
1223    link to basket
1224
1225 =head2 process_invoice
1226
1227     process_invoice(invoice_message)
1228
1229     passed a message object for an invoice, add the contained invoices
1230     and update the orderlines referred to in the invoice
1231     As an Edifact invoice is in effect a despatch note this receipts the
1232     appropriate quantities in the orders
1233
1234     no meaningful return value
1235
1236 =head2 process_ordrsp
1237
1238      process_ordrsp(ordrsp_message)
1239
1240      passed a message object for a supplier response, process the contents
1241      If an orderline is cancelled cancel the corresponding orderline in koha
1242      otherwise record the supplier message against it
1243
1244      no meaningful return value
1245
1246 =head2 create_edi_order
1247
1248     create_edi_order( { parameter_hashref } )
1249
1250     parameters must include basketno and ean
1251
1252     branchcode can optionally be passed
1253
1254     returns 1 on success undef otherwise
1255
1256     if the parameter noingest is set the formatted order is returned
1257     and not saved in the database. This functionality is intended for debugging only
1258
1259 =head2 receipt_items
1260
1261     receipt_items( schema_obj, invoice_line, ordernumber, $quantity)
1262
1263     receipts the items recorded on this invoice line
1264
1265     no meaningful return
1266
1267 =head2 transfer_items
1268
1269     transfer_items(schema, invoice_line, originating_order, receiving_order, $quantity)
1270
1271     Transfer the items covered by this invoice line from their original
1272     order to another order recording the partial fulfillment of the original
1273     order
1274
1275     no meaningful return
1276
1277 =head2 get_edifact_ean
1278
1279     $ean = get_edifact_ean();
1280
1281     routine to return the ean.
1282
1283 =head2 quote_item
1284
1285      quote_item(lineitem, quote_message);
1286
1287       Called by process_quote to handle an individual lineitem
1288      Generate the biblios and items if required and orderline linking to them
1289
1290      Returns 1 on success undef on error
1291
1292      Most usual cause of error is a line with no or incorrect budget codes
1293      which woild cause order creation to abort
1294      If other correct lines exist these are processed and the erroneous line os logged
1295
1296 =head2 title_level_class
1297
1298       classmark = title_level_class(edi_item)
1299
1300       Trys to return a title level classmark from a quote message line
1301       Will return a dewey or lcc classmark if one exists according to the
1302       value in DefaultClassificationSource syspref
1303
1304       If unable to returns the shelfmark or classification from the GIR segment
1305
1306       If all else fails returns empty string
1307
1308 =head2 _create_bib_from_quote
1309
1310        marc_record_obj = _create_bib_from_quote(lineitem, quote)
1311
1312        Returns a MARC::Record object based on the  info in the quote's lineitem
1313
1314 =head2 _create_item_from_quote
1315
1316        item_hashref = _create_item_from_quote( lineitem, quote)
1317
1318        returns a hashref representing the item fields specified in the quote
1319
1320 =head2 _get_invoiced_price
1321
1322       (price, price_tax_excluded) = _get_invoiced_price(line_object, $quantity)
1323
1324       Returns an array of unitprice and unitprice_tax_excluded derived from the lineitem
1325       monetary fields
1326
1327 =head2 _discounted_price
1328
1329       ecost = _discounted_price(discount, item_price, discounted_price)
1330
1331       utility subroutine to return a price calculated from the
1332       vendors discount and quoted price
1333       if invoice has a field containing discounted price that is returned
1334       instead of recalculating
1335
1336 =head2 _check_for_existing_bib
1337
1338      (biblionumber, biblioitemnumber) = _check_for_existing_bib(isbn_or_ean)
1339
1340      passed an isbn or ean attempts to locate a match bib
1341      On success returns biblionumber and biblioitemnumber
1342      On failure returns undefined/an empty list
1343
1344 =head2 _get_budget
1345
1346      b = _get_budget(schema_obj, budget_code)
1347
1348      Returns the Aqbudget object for the active budget given the passed budget_code
1349      or undefined if one does not exist
1350
1351 =head1 AUTHOR
1352
1353    Colin Campbell <colin.campbell@ptfs-europe.com>
1354
1355
1356 =head1 COPYRIGHT
1357
1358    Copyright 2014,2015 PTFS-Europe Ltd
1359    This program is free software, You may redistribute it under
1360    under the terms of the GNU General Public License
1361
1362
1363 =cut