Koha/EDI.pm

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