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