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