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