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