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         rrp                => $item->price,
 607         ecost => _discounted_price( $quote->vendor->discount, $item->price ),
 608         uncertainprice => 0,
 609         sort1          => q{},
 610         sort2          => q{},
 611         currency       => $vendor->listprice(),
 612     };
 613
 614     # suppliers references
 615     if ( $item->reference() ) {
 616         $order_hash->{suppliers_reference_number}    = $item->reference;
 617         $order_hash->{suppliers_reference_qualifier} = 'QLI';
 618     }
 619     elsif ( $item->orderline_reference_number() ) {
 620         $order_hash->{suppliers_reference_number} =
 621           $item->orderline_reference_number;
 622         $order_hash->{suppliers_reference_qualifier} = 'SLI';
 623     }
 624     if ( $item->item_number_id ) {    # suppliers ean
 625         $order_hash->{line_item_id} = $item->item_number_id;
 626     }
 627
 628     if ( $item->girfield('servicing_instruction') ) {
 629         my $occ = 0;
 630         my $txt = q{};
 631         my $si;
 632         while ( $si = $item->girfield( 'servicing_instruction', $occ ) ) {
 633             if ($occ) {
 634                 $txt .= q{: };
 635             }
 636             $txt .= $si;
 637             ++$occ;
 638         }
 639         $order_hash->{order_vendornote} = $txt;
 640     }
 641
 642     if ( $item->internal_notes() ) {
 643         if ( $order_hash->{order_internalnote} ) {    # more than ''
 644             $order_hash->{order_internalnote} .= q{ };
 645         }
 646         $order_hash->{order_internalnote} .= $item->internal_notes;
 647     }
 648
 649     my $budget = _get_budget( $schema, $item->girfield('fund_allocation') );
 650
 651     my $skip = '0';
 652     if ( !$budget ) {
 653         if ( $item->quantity > 1 ) {
 654             carp 'Skipping line with no budget info';
 655             $logger->trace('girfield skipped for invalid budget');
 656             $skip++;
 657         }
 658         else {
 659             carp 'Skipping line with no budget info';
 660             $logger->trace('orderline skipped for invalid budget');
 661             return;
 662         }
 663     }
 664
 665     my %ordernumber;
 666     my %budgets;
 667     my $item_hash;
 668
 669     if ( !$skip ) {
 670         $order_hash->{budget_id} = $budget->budget_id;
 671         my $first_order = $schema->resultset('Aqorder')->create($order_hash);
 672         my $o           = $first_order->ordernumber();
 673         $logger->trace("Order created :$o");
 674
 675         # should be done by database settings
 676         $first_order->parent_ordernumber( $first_order->ordernumber() );
 677         $first_order->update();
 678
 679         # add to $budgets to prevent duplicate orderlines
 680         $budgets{ $budget->budget_id } = '1';
 681
 682         # record ordernumber against budget
 683         $ordernumber{ $budget->budget_id } = $o;
 684
 685         if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
 686             $item_hash = _create_item_from_quote( $item, $quote );
 687
 688             my $created = 0;
 689             while ( $created < $order_quantity ) {
 690                 my $itemnumber;
 691                 ( $bib->{biblionumber}, $bib->{biblioitemnumber}, $itemnumber )
 692                   = AddItem( $item_hash, $bib->{biblionumber} );
 693                 $logger->trace("Added item:$itemnumber");
 694                 $schema->resultset('AqordersItem')->create(
 695                     {
 696                         ordernumber => $first_order->ordernumber,
 697                         itemnumber  => $itemnumber,
 698                     }
 699                 );
 700                 ++$created;
 701             }
 702         }
 703     }
 704
 705     if ( $order_quantity == 1 && $item->quantity > 1 ) {
 706         my $occurrence = 1;    # occ zero already added
 707         while ( $occurrence < $item->quantity ) {
 708
 709             # check budget code
 710             $budget = _get_budget( $schema,
 711                 $item->girfield( 'fund_allocation', $occurrence ) );
 712
 713             if ( !$budget ) {
 714                 my $bad_budget =
 715                   $item->girfield( 'fund_allocation', $occurrence );
 716                 carp 'Skipping line with no budget info';
 717                 $logger->trace(
 718                     "girfield skipped for invalid budget:$bad_budget");
 719                 ++$occurrence;    ## lets look at the next one not this one again
 720                 next;
 721             }
 722
 723             # add orderline for NEW budget in $budgets
 724             if ( !exists $budgets{ $budget->budget_id } ) {
 725
 726                 # $order_hash->{quantity} = 1; by default above
 727                 # we should handle both 1:1 GIR & 1:n GIR (with LQT values) here
 728
 729                 $order_hash->{budget_id} = $budget->budget_id;
 730
 731                 my $new_order =
 732                   $schema->resultset('Aqorder')->create($order_hash);
 733                 my $o = $new_order->ordernumber();
 734                 $logger->trace("Order created :$o");
 735
 736                 # should be done by database settings
 737                 $new_order->parent_ordernumber( $new_order->ordernumber() );
 738                 $new_order->update();
 739
 740                 # add to $budgets to prevent duplicate orderlines
 741                 $budgets{ $budget->budget_id } = '1';
 742
 743                 # record ordernumber against budget
 744                 $ordernumber{ $budget->budget_id } = $o;
 745
 746                 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
 747                     if ( !defined $item_hash ) {
 748                         $item_hash = _create_item_from_quote( $item, $quote );
 749                     }
 750                     my $new_item = {
 751                         itype =>
 752                           $item->girfield( 'stock_category', $occurrence ),
 753                         location =>
 754                           $item->girfield( 'collection_code', $occurrence ),
 755                         itemcallnumber =>
 756                           $item->girfield( 'shelfmark', $occurrence )
 757                           || $item->girfield( 'classification', $occurrence )
 758                           || title_level_class($item),
 759                         holdingbranch =>
 760                           $item->girfield( 'branch', $occurrence ),
 761                         homebranch => $item->girfield( 'branch', $occurrence ),
 762                     };
 763                     if ( $new_item->{itype} ) {
 764                         $item_hash->{itype} = $new_item->{itype};
 765                     }
 766                     if ( $new_item->{location} ) {
 767                         $item_hash->{location} = $new_item->{location};
 768                     }
 769                     if ( $new_item->{itemcallnumber} ) {
 770                         $item_hash->{itemcallnumber} =
 771                           $new_item->{itemcallnumber};
 772                     }
 773                     if ( $new_item->{holdingbranch} ) {
 774                         $item_hash->{holdingbranch} =
 775                           $new_item->{holdingbranch};
 776                     }
 777                     if ( $new_item->{homebranch} ) {
 778                         $item_hash->{homebranch} = $new_item->{homebranch};
 779                     }
 780
 781                     my $itemnumber;
 782                     ( undef, undef, $itemnumber ) =
 783                       AddItem( $item_hash, $bib->{biblionumber} );
 784                     $logger->trace("New item $itemnumber added");
 785                     $schema->resultset('AqordersItem')->create(
 786                         {
 787                             ordernumber => $new_order->ordernumber,
 788                             itemnumber  => $itemnumber,
 789                         }
 790                     );
 791                 }
 792
 793                 ++$occurrence;
 794             }
 795
 796             # increment quantity in orderline for EXISTING budget in $budgets
 797             else {
 798                 my $row = $schema->resultset('Aqorder')->find(
 799                     {
 800                         ordernumber => $ordernumber{ $budget->budget_id }
 801                     }
 802                 );
 803                 if ($row) {
 804                     my $qty = $row->quantity;
 805                     $qty++;
 806                     $row->update(
 807                         {
 808                             quantity => $qty,
 809                         }
 810                     );
 811                 }
 812
 813                 # Do not use the basket level value as it is always NULL
 814                 # See calling subs call to AddBasket
 815                 if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
 816                     my $new_item = {
 817                         notforloan       => -1,
 818                         cn_sort          => q{},
 819                         cn_source        => 'ddc',
 820                         price            => $item->price,
 821                         replacementprice => $item->price,
 822                         itype =>
 823                           $item->girfield( 'stock_category', $occurrence ),
 824                         location =>
 825                           $item->girfield( 'collection_code', $occurrence ),
 826                         itemcallnumber =>
 827                           $item->girfield( 'shelfmark', $occurrence )
 828                           || $item->girfield( 'classification', $occurrence )
 829                           || $item_hash->{itemcallnumber},
 830                         holdingbranch =>
 831                           $item->girfield( 'branch', $occurrence ),
 832                         homebranch => $item->girfield( 'branch', $occurrence ),
 833                     };
 834                     my $itemnumber;
 835                     ( undef, undef, $itemnumber ) =
 836                       AddItem( $new_item, $bib->{biblionumber} );
 837                     $logger->trace("New item $itemnumber added");
 838                     $schema->resultset('AqordersItem')->create(
 839                         {
 840                             ordernumber => $ordernumber{ $budget->budget_id },
 841                             itemnumber  => $itemnumber,
 842                         }
 843                     );
 844                 }
 845
 846                 ++$occurrence;
 847             }
 848         }
 849     }
 850     return 1;
 851
 852 }
 853
 854 sub get_edifact_ean {
 855
 856     my $dbh = C4::Context->dbh;
 857
 858     my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean');
 859
 860     return $eans->[0];
 861 }
 862
 863 # We should not need to have a routine to do this here
 864 sub _discounted_price {
 865     my ( $discount, $price ) = @_;
 866     return $price - ( ( $discount * $price ) / 100 );
 867 }
 868
 869 sub _check_for_existing_bib {
 870     my $isbn = shift;
 871
 872     my $search_isbn = $isbn;
 873     $search_isbn =~ s/^\s*/%/xms;
 874     $search_isbn =~ s/\s*$/%/xms;
 875     my $dbh = C4::Context->dbh;
 876     my $sth = $dbh->prepare(
 877 'select biblionumber, biblioitemnumber from biblioitems where isbn like ?',
 878     );
 879     my $tuple_arr =
 880       $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
 881     if ( @{$tuple_arr} ) {
 882         return $tuple_arr->[0];
 883     }
 884     elsif ( length($isbn) == 13 && $isbn !~ /^97[89]/ ) {
 885         my $tarr = $dbh->selectall_arrayref(
 886 'select biblionumber, biblioitemnumber from biblioitems where ean = ?',
 887             { Slice => {} },
 888             $isbn
 889         );
 890         if ( @{$tarr} ) {
 891             return $tarr->[0];
 892         }
 893     }
 894     else {
 895         undef $search_isbn;
 896         $isbn =~ s/\-//xmsg;
 897         if ( $isbn =~ m/(\d{13})/xms ) {
 898             my $b_isbn = Business::ISBN->new($1);
 899             if ( $b_isbn && $b_isbn->is_valid ) {
 900                 $search_isbn = $b_isbn->as_isbn10->as_string( [] );
 901             }
 902
 903         }
 904         elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) {
 905             my $b_isbn = Business::ISBN->new($1);
 906             if ( $b_isbn && $b_isbn->is_valid ) {
 907                 $search_isbn = $b_isbn->as_isbn13->as_string( [] );
 908             }
 909
 910         }
 911         if ($search_isbn) {
 912             $search_isbn = "%$search_isbn%";
 913             $tuple_arr =
 914               $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
 915             if ( @{$tuple_arr} ) {
 916                 return $tuple_arr->[0];
 917             }
 918         }
 919     }
 920     return;
 921 }
 922
 923 # returns a budget obj or undef
 924 # fact we need this shows what a mess Acq API is
 925 sub _get_budget {
 926     my ( $schema, $budget_code ) = @_;
 927     my $period_rs = $schema->resultset('Aqbudgetperiod')->search(
 928         {
 929             budget_period_active => 1,
 930         }
 931     );
 932
 933     # db does not ensure budget code is unque
 934     return $schema->resultset('Aqbudget')->single(
 935         {
 936             budget_code => $budget_code,
 937             budget_period_id =>
 938               { -in => $period_rs->get_column('budget_period_id')->as_query },
 939         }
 940     );
 941 }
 942
 943 # try to get title level classification from incoming quote
 944 sub title_level_class {
 945     my ($item)         = @_;
 946     my $class          = q{};
 947     my $default_scheme = C4::Context->preference('DefaultClassificationSource');
 948     if ( $default_scheme eq 'ddc' ) {
 949         $class = $item->dewey_class();
 950     }
 951     elsif ( $default_scheme eq 'lcc' ) {
 952         $class = $item->lc_class();
 953     }
 954     if ( !$class ) {
 955         $class =
 956              $item->girfield('shelfmark')
 957           || $item->girfield('classification')
 958           || q{};
 959     }
 960     return $class;
 961 }
 962
 963 sub _create_bib_from_quote {
 964
 965     #TBD we should flag this for updating from an external source
 966     #As biblio (&biblioitems) has no candidates flag in order
 967     my ( $item, $quote ) = @_;
 968     my $itemid = $item->item_number_id;
 969     my $defalt_classification_source =
 970       C4::Context->preference('DefaultClassificationSource');
 971     my $bib_hash = {
 972         'biblioitems.cn_source' => $defalt_classification_source,
 973         'items.cn_source'       => $defalt_classification_source,
 974         'items.notforloan'      => -1,
 975         'items.cn_sort'         => q{},
 976     };
 977     $bib_hash->{'biblio.seriestitle'} = $item->series;
 978
 979     $bib_hash->{'biblioitems.publishercode'} = $item->publisher;
 980     $bib_hash->{'biblioitems.publicationyear'} =
 981       $bib_hash->{'biblio.copyrightdate'} = $item->publication_date;
 982
 983     $bib_hash->{'biblio.title'}         = $item->title;
 984     $bib_hash->{'biblio.author'}        = $item->author;
 985     $bib_hash->{'biblioitems.isbn'}     = $item->item_number_id;
 986     $bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category');
 987
 988     # If we have a 13 digit id we are assuming its an ean
 989     # (it may also be an isbn or issn)
 990     if ( $itemid =~ /^\d{13}$/ ) {
 991         $bib_hash->{'biblioitems.ean'} = $itemid;
 992         if ( $itemid =~ /^977/ ) {
 993             $bib_hash->{'biblioitems.issn'} = $itemid;
 994         }
 995     }
 996     for my $key ( keys %{$bib_hash} ) {
 997         if ( !defined $bib_hash->{$key} ) {
 998             delete $bib_hash->{$key};
 999         }
1000     }
1001     return TransformKohaToMarc($bib_hash);
1002
1003 }
1004
1005 sub _create_item_from_quote {
1006     my ( $item, $quote ) = @_;
1007     my $defalt_classification_source =
1008       C4::Context->preference('DefaultClassificationSource');
1009     my $item_hash = {
1010         cn_source  => $defalt_classification_source,
1011         notforloan => -1,
1012         cn_sort    => q{},
1013     };
1014     $item_hash->{booksellerid} = $quote->vendor_id;
1015     $item_hash->{price}        = $item_hash->{replacementprice} = $item->price;
1016     $item_hash->{itype}        = $item->girfield('stock_category');
1017     $item_hash->{location}     = $item->girfield('collection_code');
1018
1019     my $note = {};
1020
1021     $item_hash->{itemcallnumber} =
1022          $item->girfield('shelfmark')
1023       || $item->girfield('classification')
1024       || title_level_class($item);
1025
1026     my $branch = $item->girfield('branch');
1027     $item_hash->{holdingbranch} = $item_hash->{homebranch} = $branch;
1028     return $item_hash;
1029 }
1030
1031 1;
1032 __END__
1033
1034 =head1 NAME
1035
1036 Koha::EDI
1037
1038 =head1 SYNOPSIS
1039
1040    Module exporting subroutines used in EDI processing for Koha
1041
1042 =head1 DESCRIPTION
1043
1044    Subroutines called by batch processing to handle Edifact
1045    messages of various types and related utilities
1046
1047 =head1 BUGS
1048
1049    These routines should really be methods of some object.
1050    get_edifact_ean is a stopgap which should be replaced
1051
1052 =head1 SUBROUTINES
1053
1054 =head2 process_quote
1055
1056     process_quote(quote_message);
1057
1058    passed a message object for a quote, parses it creating an order basket
1059    and orderlines in the database
1060    updates the message's status to received in the database and adds the
1061    link to basket
1062
1063 =head2 process_invoice
1064
1065     process_invoice(invoice_message)
1066
1067     passed a message object for an invoice, add the contained invoices
1068     and update the orderlines referred to in the invoice
1069     As an Edifact invoice is in effect a despatch note this receipts the
1070     appropriate quantities in the orders
1071
1072     no meaningful return value
1073
1074 =head2 process_ordrsp
1075
1076      process_ordrsp(ordrsp_message)
1077
1078      passed a message object for a supplier response, process the contents
1079      If an orderline is cancelled cancel the corresponding orderline in koha
1080      otherwise record the supplier message against it
1081
1082      no meaningful return value
1083
1084 =head2 create_edi_order
1085
1086     create_edi_order( { parameter_hashref } )
1087
1088     parameters must include basketno and ean
1089
1090     branchcode can optionally be passed
1091
1092     returns 1 on success undef otherwise
1093
1094     if the parameter noingest is set the formatted order is returned
1095     and not saved in the database. This functionality is intended for debugging only
1096
1097 =head2 receipt_items
1098
1099     receipt_items( schema_obj, invoice_line, ordernumber)
1100
1101     receipts the items recorded on this invoice line
1102
1103     no meaningful return
1104
1105 =head2 transfer_items
1106
1107     transfer_items(schema, invoice_line, originating_order, receiving_order)
1108
1109     Transfer the items covered by this invoice line from their original
1110     order to another order recording the partial fulfillment of the original
1111     order
1112
1113     no meaningful return
1114
1115 =head2 get_edifact_ean
1116
1117     $ean = get_edifact_ean();
1118
1119     routine to return the ean.
1120
1121 =head2 quote_item
1122
1123      quote_item(lineitem, quote_message);
1124
1125       Called by process_quote to handle an individual lineitem
1126      Generate the biblios and items if required and orderline linking to them
1127
1128      Returns 1 on success undef on error
1129
1130      Most usual cause of error is a line with no or incorrect budget codes
1131      which woild cause order creation to abort
1132      If other correct lines exist these are processed and the erroneous line os logged
1133
1134 =head2 title_level_class
1135
1136       classmark = title_level_class(edi_item)
1137
1138       Trys to return a title level classmark from a quote message line
1139       Will return a dewey or lcc classmark if one exists according to the
1140       value in DefaultClassificationSource syspref
1141
1142       If unable to returns the shelfmark or classification from the GIR segment
1143
1144       If all else fails returns empty string
1145
1146 =head2 _create_bib_from_quote
1147
1148        marc_record_obj = _create_bib_from_quote(lineitem, quote)
1149
1150        Returns a MARC::Record object based on the  info in the quote's lineitem
1151
1152 =head2 _create_item_from_quote
1153
1154        item_hashref = _create_item_from_quote( lineitem, quote)
1155
1156        returns a hashref representing the item fields specified in the quote
1157
1158 =head2 _get_invoiced_price
1159
1160       _get_invoiced_price(line_object)
1161
1162       Returns the net price or an equivalent calculated from line cost / qty
1163
1164 =head2 _discounted_price
1165
1166       ecost = _discounted_price(discount, item_price)
1167
1168       utility subroutine to return a price calculated from the
1169       vendors discount and quoted price
1170
1171 =head2 _check_for_existing_bib
1172
1173      (biblionumber, biblioitemnumber) = _check_for_existing_bib(isbn_or_ean)
1174
1175      passed an isbn or ean attempts to locate a match bib
1176      On success returns biblionumber and biblioitemnumber
1177      On failure returns undefined/an empty list
1178
1179 =head2 _get_budget
1180
1181      b = _get_budget(schema_obj, budget_code)
1182
1183      Returns the Aqbudget object for the active budget given the passed budget_code
1184      or undefined if one does not exist
1185
1186 =head1 AUTHOR
1187
1188    Colin Campbell <colin.campbell@ptfs-europe.com>
1189
1190
1191 =head1 COPYRIGHT
1192
1193    Copyright 2014,2015 PTFS-Europe Ltd
1194    This program is free software, You may redistribute it under
1195    under the terms of the GNU General Public License
1196
1197
1198 =cut