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::Items qw(AddItem);
  33 use C4::Biblio qw( AddBiblio TransformKohaToMarc GetMarcBiblio );
  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 => DateTime->now()->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     my $gir_occurrence = 0;
 392     while ( $gir_occurrence < $quantity ) {
 393         my $branch = $inv_line->girfield( 'branch', $gir_occurrence );
 394         my $item = shift @{ $branch_map{$branch} };
 395         if ($item) {
 396             my $barcode = $inv_line->girfield( 'barcode', $gir_occurrence );
 397             if ( $barcode && !$item->barcode ) {
 398                 my $rs = $schema->resultset('Item')->search(
 399                     {
 400                         barcode => $barcode,
 401                     }
 402                 );
 403                 if ( $rs->count > 0 ) {
 404                     $logger->warn("Barcode $barcode is a duplicate");
 405                 }
 406                 else {
 407
 408                     $logger->trace("Adding barcode $barcode");
 409                     $item->barcode($barcode);
 410                 }
 411             }
 412
 413             $item->update;
 414         }
 415         else {
 416             $logger->warn("Unmatched item at branch:$branch");
 417         }
 418         ++$gir_occurrence;
 419     }
 420     return;
 421
 422 }
 423
 424 sub transfer_items {
 425     my ( $schema, $inv_line, $order_from, $order_to ) = @_;
 426
 427     # Transfer x items from the orig order to a completed partial order
 428     my $quantity = $inv_line->quantity;
 429     my $gocc     = 0;
 430     my %mapped_by_branch;
 431     while ( $gocc < $quantity ) {
 432         my $branch = $inv_line->girfield( 'branch', $gocc );
 433         if ( !exists $mapped_by_branch{$branch} ) {
 434             $mapped_by_branch{$branch} = 1;
 435         }
 436         else {
 437             $mapped_by_branch{$branch}++;
 438         }
 439         ++$gocc;
 440     }
 441     my $logger = Log::Log4perl->get_logger();
 442     my $o1     = $order_from->ordernumber;
 443     my $o2     = $order_to->ordernumber;
 444     $logger->warn("transferring $quantity copies from order $o1 to order $o2");
 445
 446     my @item_links = $schema->resultset('AqordersItem')->search(
 447         {
 448             ordernumber => $order_from->ordernumber,
 449         }
 450     );
 451     foreach my $ilink (@item_links) {
 452         my $ino      = $ilink->itemnumber;
 453         my $item     = $schema->resultset('Item')->find( $ilink->itemnumber );
 454         my $i_branch = $item->homebranch;
 455         if ( exists $mapped_by_branch{$i_branch}
 456             && $mapped_by_branch{$i_branch} > 0 )
 457         {
 458             $ilink->ordernumber( $order_to->ordernumber );
 459             $ilink->update;
 460             --$quantity;
 461             --$mapped_by_branch{$i_branch};
 462             $logger->warn("Transferred item $item");
 463         }
 464         else {
 465             $logger->warn("Skipped item $item");
 466         }
 467         if ( $quantity < 1 ) {
 468             last;
 469         }
 470     }
 471
 472     return;
 473 }
 474
 475 sub process_quote {
 476     my $quote = shift;
 477
 478     $quote->status('processing');
 479     $quote->update;
 480
 481     my $edi = Koha::Edifact->new( { transmission => $quote->raw_msg, } );
 482
 483     my $messages       = $edi->message_array();
 484     my $process_errors = 0;
 485     my $logger         = Log::Log4perl->get_logger();
 486     my $schema         = Koha::Database->new()->schema();
 487     my $message_count  = 0;
 488     my @added_baskets;    # if auto & multiple baskets need to order all
 489
 490     if ( @{$messages} && $quote->vendor_id ) {
 491         foreach my $msg ( @{$messages} ) {
 492             ++$message_count;
 493             my $basketno =
 494               NewBasket( $quote->vendor_id, 0, $quote->filename, q{},
 495                 q{} . q{} );
 496             push @added_baskets, $basketno;
 497             if ( $message_count > 1 ) {
 498                 my $m_filename = $quote->filename;
 499                 $m_filename .= "_$message_count";
 500                 $schema->resultset('EdifactMessage')->create(
 501                     {
 502                         message_type  => $quote->message_type,
 503                         transfer_date => $quote->transfer_date,
 504                         vendor_id     => $quote->vendor_id,
 505                         edi_acct      => $quote->edi_acct,
 506                         status        => 'recmsg',
 507                         basketno      => $basketno,
 508                         raw_msg       => q{},
 509                         filename      => $m_filename,
 510                     }
 511                 );
 512             }
 513             else {
 514                 $quote->basketno($basketno);
 515             }
 516             $logger->trace("Created basket :$basketno");
 517             my $items  = $msg->lineitems();
 518             my $refnum = $msg->message_refno;
 519
 520             for my $item ( @{$items} ) {
 521                 if ( !quote_item( $item, $quote, $basketno ) ) {
 522                     ++$process_errors;
 523                 }
 524             }
 525         }
 526     }
 527     my $status = 'received';
 528     if ($process_errors) {
 529         $status = 'error';
 530     }
 531
 532     $quote->status($status);
 533     $quote->update;    # status and basketno link
 534                        # Do we automatically generate orders for this vendor
 535     my $v = $schema->resultset('VendorEdiAccount')->search(
 536         {
 537             vendor_id => $quote->vendor_id,
 538         }
 539     )->single;
 540     if ( $v->auto_orders ) {
 541         for my $b (@added_baskets) {
 542             create_edi_order(
 543                 {
 544
 545                     basketno => $b,
 546                 }
 547             );
 548             CloseBasket($b);
 549         }
 550     }
 551
 552     return;
 553 }
 554
 555 sub quote_item {
 556     my ( $item, $quote, $basketno ) = @_;
 557
 558     my $schema = Koha::Database->new()->schema();
 559     my $logger = Log::Log4perl->get_logger();
 560
 561     # $basketno is the return from AddBasket in the calling routine
 562     # So this call should not fail unless that has
 563     my $basket = Koha::Acquisition::Baskets->find( $basketno );
 564     unless ( $basket ) {
 565         $logger->error('Skipping order creation no valid basketno');
 566         return;
 567     }
 568     $logger->trace( 'Checking db for matches with ', $item->item_number_id() );
 569     my $bib = _check_for_existing_bib( $item->item_number_id() );
 570     if ( !defined $bib ) {
 571         $bib = {};
 572         my $bib_record = _create_bib_from_quote( $item, $quote );
 573         ( $bib->{biblionumber}, $bib->{biblioitemnumber} ) =
 574           AddBiblio( $bib_record, q{} );
 575         $logger->trace("New biblio added $bib->{biblionumber}");
 576     }
 577     else {
 578         $logger->trace("Match found: $bib->{biblionumber}");
 579     }
 580
 581     # Create an orderline
 582     my $order_note = $item->{orderline_free_text};
 583     $order_note ||= q{};
 584     my $order_quantity = $item->quantity();
 585     my $gir_count      = $item->number_of_girs();
 586     $order_quantity ||= 1;    # quantity not necessarily present
 587     if ( $gir_count > 1 ) {
 588         if ( $gir_count != $order_quantity ) {
 589             $logger->error(
 590                 "Order for $order_quantity items, $gir_count segments present");
 591         }
 592         $order_quantity = 1;    # attempts to create an orderline for each gir
 593     }
 594     my $vendor = Koha::Acquisition::Booksellers->find( $quote->vendor_id );
 595
 596     # database definitions should set some of these defaults but dont
 597     my $order_hash = {
 598         biblionumber       => $bib->{biblionumber},
 599         entrydate          => DateTime->now( time_zone => 'local' )->ymd(),
 600         basketno           => $basketno,
 601         listprice          => $item->price,
 602         quantity           => $order_quantity,
 603         quantityreceived   => 0,
 604         order_vendornote   => q{},
 605         order_internalnote => $order_note,
 606         replacementprice   => $item->price,
 607         rrp_tax_included   => $item->price,
 608         rrp_tax_excluded   => $item->price,
 609         ecost => _discounted_price( $quote->vendor->discount, $item->price ),
 610         uncertainprice => 0,
 611         sort1          => q{},
 612         sort2          => q{},
 613         currency       => $vendor->listprice(),
 614     };
 615
 616     # suppliers references
 617     if ( $item->reference() ) {
 618         $order_hash->{suppliers_reference_number}    = $item->reference;
 619         $order_hash->{suppliers_reference_qualifier} = 'QLI';
 620     }
 621     elsif ( $item->orderline_reference_number() ) {
 622         $order_hash->{suppliers_reference_number} =
 623           $item->orderline_reference_number;
 624         $order_hash->{suppliers_reference_qualifier} = 'SLI';
 625     }
 626     if ( $item->item_number_id ) {    # suppliers ean
 627         $order_hash->{line_item_id} = $item->item_number_id;
 628     }
 629
 630     if ( $item->girfield('servicing_instruction') ) {
 631         my $occ = 0;
 632         my $txt = q{};
 633         my $si;
 634         while ( $si = $item->girfield( 'servicing_instruction', $occ ) ) {
 635             if ($occ) {
 636                 $txt .= q{: };
 637             }
 638             $txt .= $si;
 639             ++$occ;
 640         }
 641         $order_hash->{order_vendornote} = $txt;
 642     }
 643
 644     if ( $item->internal_notes() ) {
 645         if ( $order_hash->{order_internalnote} ) {    # more than ''
 646             $order_hash->{order_internalnote} .= q{ };
 647         }
 648         $order_hash->{order_internalnote} .= $item->internal_notes;
 649     }
 650
 651     my $budget = _get_budget( $schema, $item->girfield('fund_allocation') );
 652
 653     my $skip = '0';
 654     if ( !$budget ) {
 655         if ( $item->quantity > 1 ) {
 656             carp 'Skipping line with no budget info';
 657             $logger->trace('girfield skipped for invalid budget');
 658             $skip++;
 659         }
 660         else {
 661             carp 'Skipping line with no budget info';
 662             $logger->trace('orderline skipped for invalid budget');
 663             return;
 664         }
 665     }
 666
 667     my %ordernumber;
 668     my %budgets;
 669     my $item_hash;
 670
 671     if ( !$skip ) {
 672         $order_hash->{budget_id} = $budget->budget_id;
 673         my $first_order = $schema->resultset('Aqorder')->create($order_hash);
 674         my $o           = $first_order->ordernumber();
 675         $logger->trace("Order created :$o");
 676
 677         # should be done by database settings
 678         $first_order->parent_ordernumber( $first_order->ordernumber() );
 679         $first_order->update();
 680
 681         # add to $budgets to prevent duplicate orderlines
 682         $budgets{ $budget->budget_id } = '1';
 683
 684         # record ordernumber against budget
 685         $ordernumber{ $budget->budget_id } = $o;
 686
 687         if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
 688             $item_hash = _create_item_from_quote( $item, $quote );
 689
 690             my $created = 0;
 691             while ( $created < $order_quantity ) {
 692                 my $itemnumber;
 693                 ( $bib->{biblionumber}, $bib->{biblioitemnumber}, $itemnumber )
 694                   = AddItem( $item_hash, $bib->{biblionumber} );
 695                 $logger->trace("Added item:$itemnumber");
 696                 $schema->resultset('AqordersItem')->create(
 697                     {
 698                         ordernumber => $first_order->ordernumber,
 699                         itemnumber  => $itemnumber,
 700                     }
 701                 );
 702                 ++$created;
 703             }
 704         }
 705     }
 706
 707     if ( $order_quantity == 1 && $item->quantity > 1 ) {
 708         my $occurrence = 1;    # occ zero already added
 709         while ( $occurrence < $item->quantity ) {
 710
 711             # check budget code
 712             $budget = _get_budget( $schema,
 713                 $item->girfield( 'fund_allocation', $occurrence ) );
 714
 715             if ( !$budget ) {
 716                 my $bad_budget =
 717                   $item->girfield( 'fund_allocation', $occurrence );
 718                 carp 'Skipping line with no budget info';
 719                 $logger->trace(
 720                     "girfield skipped for invalid budget:$bad_budget");
 721                 ++$occurrence;    ## lets look at the next one not this one again
 722                 next;
 723             }
 724
 725             # add orderline for NEW budget in $budgets
 726             if ( !exists $budgets{ $budget->budget_id } ) {
 727
 728                 # $order_hash->{quantity} = 1; by default above
 729                 # we should handle both 1:1 GIR & 1:n GIR (with LQT values) here
 730
 731                 $order_hash->{budget_id} = $budget->budget_id;
 732
 733                 my $new_order =
 734                   $schema->resultset('Aqorder')->create($order_hash);
 735                 my $o = $new_order->ordernumber();
 736                 $logger->trace("Order created :$o");
 737
 738                 # should be done by database settings
 739                 $new_order->parent_ordernumber( $new_order->ordernumber() );
 740                 $new_order->update();
 741
 742                 # add to $budgets to prevent duplicate orderlines
 743                 $budgets{ $budget->budget_id } = '1';
 744
 745                 # record ordernumber against budget
 746                 $ordernumber{ $budget->budget_id } = $o;
 747
 748                 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
 749                     if ( !defined $item_hash ) {
 750                         $item_hash = _create_item_from_quote( $item, $quote );
 751                     }
 752                     my $new_item = {
 753                         itype =>
 754                           $item->girfield( 'stock_category', $occurrence ),
 755                         location =>
 756                           $item->girfield( 'collection_code', $occurrence ),
 757                         itemcallnumber =>
 758                           $item->girfield( 'shelfmark', $occurrence )
 759                           || $item->girfield( 'classification', $occurrence )
 760                           || title_level_class($item),
 761                         holdingbranch =>
 762                           $item->girfield( 'branch', $occurrence ),
 763                         homebranch => $item->girfield( 'branch', $occurrence ),
 764                     };
 765                     if ( $new_item->{itype} ) {
 766                         $item_hash->{itype} = $new_item->{itype};
 767                     }
 768                     if ( $new_item->{location} ) {
 769                         $item_hash->{location} = $new_item->{location};
 770                     }
 771                     if ( $new_item->{itemcallnumber} ) {
 772                         $item_hash->{itemcallnumber} =
 773                           $new_item->{itemcallnumber};
 774                     }
 775                     if ( $new_item->{holdingbranch} ) {
 776                         $item_hash->{holdingbranch} =
 777                           $new_item->{holdingbranch};
 778                     }
 779                     if ( $new_item->{homebranch} ) {
 780                         $item_hash->{homebranch} = $new_item->{homebranch};
 781                     }
 782
 783                     my $itemnumber;
 784                     ( undef, undef, $itemnumber ) =
 785                       AddItem( $item_hash, $bib->{biblionumber} );
 786                     $logger->trace("New item $itemnumber added");
 787                     $schema->resultset('AqordersItem')->create(
 788                         {
 789                             ordernumber => $new_order->ordernumber,
 790                             itemnumber  => $itemnumber,
 791                         }
 792                     );
 793                 }
 794
 795                 ++$occurrence;
 796             }
 797
 798             # increment quantity in orderline for EXISTING budget in $budgets
 799             else {
 800                 my $row = $schema->resultset('Aqorder')->find(
 801                     {
 802                         ordernumber => $ordernumber{ $budget->budget_id }
 803                     }
 804                 );
 805                 if ($row) {
 806                     my $qty = $row->quantity;
 807                     $qty++;
 808                     $row->update(
 809                         {
 810                             quantity => $qty,
 811                         }
 812                     );
 813                 }
 814
 815                 # Do not use the basket level value as it is always NULL
 816                 # See calling subs call to AddBasket
 817                 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
 818                     my $new_item = {
 819                         notforloan       => -1,
 820                         cn_sort          => q{},
 821                         cn_source        => 'ddc',
 822                         price            => $item->price,
 823                         replacementprice => $item->price,
 824                         itype =>
 825                           $item->girfield( 'stock_category', $occurrence ),
 826                         location =>
 827                           $item->girfield( 'collection_code', $occurrence ),
 828                         itemcallnumber =>
 829                           $item->girfield( 'shelfmark', $occurrence )
 830                           || $item->girfield( 'classification', $occurrence )
 831                           || $item_hash->{itemcallnumber},
 832                         holdingbranch =>
 833                           $item->girfield( 'branch', $occurrence ),
 834                         homebranch => $item->girfield( 'branch', $occurrence ),
 835                     };
 836                     my $itemnumber;
 837                     ( undef, undef, $itemnumber ) =
 838                       AddItem( $new_item, $bib->{biblionumber} );
 839                     $logger->trace("New item $itemnumber added");
 840                     $schema->resultset('AqordersItem')->create(
 841                         {
 842                             ordernumber => $ordernumber{ $budget->budget_id },
 843                             itemnumber  => $itemnumber,
 844                         }
 845                     );
 846                 }
 847
 848                 ++$occurrence;
 849             }
 850         }
 851     }
 852     return 1;
 853
 854 }
 855
 856 sub get_edifact_ean {
 857
 858     my $dbh = C4::Context->dbh;
 859
 860     my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean');
 861
 862     return $eans->[0];
 863 }
 864
 865 # We should not need to have a routine to do this here
 866 sub _discounted_price {
 867     my ( $discount, $price ) = @_;
 868     return $price - ( ( $discount * $price ) / 100 );
 869 }
 870
 871 sub _check_for_existing_bib {
 872     my $isbn = shift;
 873
 874     my $search_isbn = $isbn;
 875     $search_isbn =~ s/^\s*/%/xms;
 876     $search_isbn =~ s/\s*$/%/xms;
 877     my $dbh = C4::Context->dbh;
 878     my $sth = $dbh->prepare(
 879 'select biblionumber, biblioitemnumber from biblioitems where isbn like ?',
 880     );
 881     my $tuple_arr =
 882       $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
 883     if ( @{$tuple_arr} ) {
 884         return $tuple_arr->[0];
 885     }
 886     elsif ( length($isbn) == 13 && $isbn !~ /^97[89]/ ) {
 887         my $tarr = $dbh->selectall_arrayref(
 888 'select biblionumber, biblioitemnumber from biblioitems where ean = ?',
 889             { Slice => {} },
 890             $isbn
 891         );
 892         if ( @{$tarr} ) {
 893             return $tarr->[0];
 894         }
 895     }
 896     else {
 897         undef $search_isbn;
 898         $isbn =~ s/\-//xmsg;
 899         if ( $isbn =~ m/(\d{13})/xms ) {
 900             my $b_isbn = Business::ISBN->new($1);
 901             if ( $b_isbn && $b_isbn->is_valid ) {
 902                 $search_isbn = $b_isbn->as_isbn10->as_string( [] );
 903             }
 904
 905         }
 906         elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) {
 907             my $b_isbn = Business::ISBN->new($1);
 908             if ( $b_isbn && $b_isbn->is_valid ) {
 909                 $search_isbn = $b_isbn->as_isbn13->as_string( [] );
 910             }
 911
 912         }
 913         if ($search_isbn) {
 914             $search_isbn = "%$search_isbn%";
 915             $tuple_arr =
 916               $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
 917             if ( @{$tuple_arr} ) {
 918                 return $tuple_arr->[0];
 919             }
 920         }
 921     }
 922     return;
 923 }
 924
 925 # returns a budget obj or undef
 926 # fact we need this shows what a mess Acq API is
 927 sub _get_budget {
 928     my ( $schema, $budget_code ) = @_;
 929     my $period_rs = $schema->resultset('Aqbudgetperiod')->search(
 930         {
 931             budget_period_active => 1,
 932         }
 933     );
 934
 935     # db does not ensure budget code is unque
 936     return $schema->resultset('Aqbudget')->single(
 937         {
 938             budget_code => $budget_code,
 939             budget_period_id =>
 940               { -in => $period_rs->get_column('budget_period_id')->as_query },
 941         }
 942     );
 943 }
 944
 945 # try to get title level classification from incoming quote
 946 sub title_level_class {
 947     my ($item)         = @_;
 948     my $class          = q{};
 949     my $default_scheme = C4::Context->preference('DefaultClassificationSource');
 950     if ( $default_scheme eq 'ddc' ) {
 951         $class = $item->dewey_class();
 952     }
 953     elsif ( $default_scheme eq 'lcc' ) {
 954         $class = $item->lc_class();
 955     }
 956     if ( !$class ) {
 957         $class =
 958              $item->girfield('shelfmark')
 959           || $item->girfield('classification')
 960           || q{};
 961     }
 962     return $class;
 963 }
 964
 965 sub _create_bib_from_quote {
 966
 967     #TBD we should flag this for updating from an external source
 968     #As biblio (&biblioitems) has no candidates flag in order
 969     my ( $item, $quote ) = @_;
 970     my $itemid = $item->item_number_id;
 971     my $defalt_classification_source =
 972       C4::Context->preference('DefaultClassificationSource');
 973     my $bib_hash = {
 974         'biblioitems.cn_source' => $defalt_classification_source,
 975         'items.cn_source'       => $defalt_classification_source,
 976         'items.notforloan'      => -1,
 977         'items.cn_sort'         => q{},
 978     };
 979     $bib_hash->{'biblio.seriestitle'} = $item->series;
 980
 981     $bib_hash->{'biblioitems.publishercode'} = $item->publisher;
 982     $bib_hash->{'biblioitems.publicationyear'} =
 983       $bib_hash->{'biblio.copyrightdate'} = $item->publication_date;
 984
 985     $bib_hash->{'biblio.title'}         = $item->title;
 986     $bib_hash->{'biblio.author'}        = $item->author;
 987     $bib_hash->{'biblioitems.isbn'}     = $item->item_number_id;
 988     $bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category');
 989
 990     # If we have a 13 digit id we are assuming its an ean
 991     # (it may also be an isbn or issn)
 992     if ( $itemid =~ /^\d{13}$/ ) {
 993         $bib_hash->{'biblioitems.ean'} = $itemid;
 994         if ( $itemid =~ /^977/ ) {
 995             $bib_hash->{'biblioitems.issn'} = $itemid;
 996         }
 997     }
 998     for my $key ( keys %{$bib_hash} ) {
 999         if ( !defined $bib_hash->{$key} ) {
1000             delete $bib_hash->{$key};
1001         }
1002     }
1003     return TransformKohaToMarc($bib_hash);
1004
1005 }
1006
1007 sub _create_item_from_quote {
1008     my ( $item, $quote ) = @_;
1009     my $defalt_classification_source =
1010       C4::Context->preference('DefaultClassificationSource');
1011     my $item_hash = {
1012         cn_source  => $defalt_classification_source,
1013         notforloan => -1,
1014         cn_sort    => q{},
1015     };
1016     $item_hash->{booksellerid} = $quote->vendor_id;
1017     $item_hash->{price}        = $item_hash->{replacementprice} = $item->price;
1018     $item_hash->{itype}        = $item->girfield('stock_category');
1019     $item_hash->{location}     = $item->girfield('collection_code');
1020
1021     my $note = {};
1022
1023     $item_hash->{itemcallnumber} =
1024          $item->girfield('shelfmark')
1025       || $item->girfield('classification')
1026       || title_level_class($item);
1027
1028     my $branch = $item->girfield('branch');
1029     $item_hash->{holdingbranch} = $item_hash->{homebranch} = $branch;
1030     return $item_hash;
1031 }
1032
1033 1;
1034 __END__
1035
1036 =head1 NAME
1037
1038 Koha::EDI
1039
1040 =head1 SYNOPSIS
1041
1042    Module exporting subroutines used in EDI processing for Koha
1043
1044 =head1 DESCRIPTION
1045
1046    Subroutines called by batch processing to handle Edifact
1047    messages of various types and related utilities
1048
1049 =head1 BUGS
1050
1051    These routines should really be methods of some object.
1052    get_edifact_ean is a stopgap which should be replaced
1053
1054 =head1 SUBROUTINES
1055
1056 =head2 process_quote
1057
1058     process_quote(quote_message);
1059
1060    passed a message object for a quote, parses it creating an order basket
1061    and orderlines in the database
1062    updates the message's status to received in the database and adds the
1063    link to basket
1064
1065 =head2 process_invoice
1066
1067     process_invoice(invoice_message)
1068
1069     passed a message object for an invoice, add the contained invoices
1070     and update the orderlines referred to in the invoice
1071     As an Edifact invoice is in effect a despatch note this receipts the
1072     appropriate quantities in the orders
1073
1074     no meaningful return value
1075
1076 =head2 process_ordrsp
1077
1078      process_ordrsp(ordrsp_message)
1079
1080      passed a message object for a supplier response, process the contents
1081      If an orderline is cancelled cancel the corresponding orderline in koha
1082      otherwise record the supplier message against it
1083
1084      no meaningful return value
1085
1086 =head2 create_edi_order
1087
1088     create_edi_order( { parameter_hashref } )
1089
1090     parameters must include basketno and ean
1091
1092     branchcode can optionally be passed
1093
1094     returns 1 on success undef otherwise
1095
1096     if the parameter noingest is set the formatted order is returned
1097     and not saved in the database. This functionality is intended for debugging only
1098
1099 =head2 receipt_items
1100
1101     receipt_items( schema_obj, invoice_line, ordernumber)
1102
1103     receipts the items recorded on this invoice line
1104
1105     no meaningful return
1106
1107 =head2 transfer_items
1108
1109     transfer_items(schema, invoice_line, originating_order, receiving_order)
1110
1111     Transfer the items covered by this invoice line from their original
1112     order to another order recording the partial fulfillment of the original
1113     order
1114
1115     no meaningful return
1116
1117 =head2 get_edifact_ean
1118
1119     $ean = get_edifact_ean();
1120
1121     routine to return the ean.
1122
1123 =head2 quote_item
1124
1125      quote_item(lineitem, quote_message);
1126
1127       Called by process_quote to handle an individual lineitem
1128      Generate the biblios and items if required and orderline linking to them
1129
1130      Returns 1 on success undef on error
1131
1132      Most usual cause of error is a line with no or incorrect budget codes
1133      which woild cause order creation to abort
1134      If other correct lines exist these are processed and the erroneous line os logged
1135
1136 =head2 title_level_class
1137
1138       classmark = title_level_class(edi_item)
1139
1140       Trys to return a title level classmark from a quote message line
1141       Will return a dewey or lcc classmark if one exists according to the
1142       value in DefaultClassificationSource syspref
1143
1144       If unable to returns the shelfmark or classification from the GIR segment
1145
1146       If all else fails returns empty string
1147
1148 =head2 _create_bib_from_quote
1149
1150        marc_record_obj = _create_bib_from_quote(lineitem, quote)
1151
1152        Returns a MARC::Record object based on the  info in the quote's lineitem
1153
1154 =head2 _create_item_from_quote
1155
1156        item_hashref = _create_item_from_quote( lineitem, quote)
1157
1158        returns a hashref representing the item fields specified in the quote
1159
1160 =head2 _get_invoiced_price
1161
1162       _get_invoiced_price(line_object)
1163
1164       Returns the net price or an equivalent calculated from line cost / qty
1165
1166 =head2 _discounted_price
1167
1168       ecost = _discounted_price(discount, item_price)
1169
1170       utility subroutine to return a price calculated from the
1171       vendors discount and quoted price
1172
1173 =head2 _check_for_existing_bib
1174
1175      (biblionumber, biblioitemnumber) = _check_for_existing_bib(isbn_or_ean)
1176
1177      passed an isbn or ean attempts to locate a match bib
1178      On success returns biblionumber and biblioitemnumber
1179      On failure returns undefined/an empty list
1180
1181 =head2 _get_budget
1182
1183      b = _get_budget(schema_obj, budget_code)
1184
1185      Returns the Aqbudget object for the active budget given the passed budget_code
1186      or undefined if one does not exist
1187
1188 =head1 AUTHOR
1189
1190    Colin Campbell <colin.campbell@ptfs-europe.com>
1191
1192
1193 =head1 COPYRIGHT
1194
1195    Copyright 2014,2015 PTFS-Europe Ltd
1196    This program is free software, You may redistribute it under
1197    under the terms of the GNU General Public License
1198
1199
1200 =cut