Koha/EDI.pm

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