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