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