Koha/EDI.pm

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