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