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