C4/Acquisition.pm

   1 package C4::Acquisition;
   2
   3 # Copyright 2000-2002 Katipo Communications
   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
  21 use Modern::Perl;
  22 use Carp qw( carp croak );
  23 use Text::CSV_XS;
  24 use C4::Context;
  25 use C4::Suggestions qw( GetSuggestion GetSuggestionFromBiblionumber ModSuggestion );
  26 use C4::Biblio qw( GetMarcFromKohaField GetMarcStructure IsMarcStructureInternal );
  27 use C4::Contract qw( GetContract );
  28 use C4::Log qw( logaction );
  29 use C4::Templates qw(gettemplate);
  30 use Koha::DateUtils qw( dt_from_string );
  31 use Koha::Acquisition::Baskets;
  32 use Koha::Acquisition::Booksellers;
  33 use Koha::Acquisition::Orders;
  34 use Koha::Biblios;
  35 use Koha::Exceptions;
  36 use Koha::Items;
  37 use Koha::Number::Price;
  38 use Koha::Libraries;
  39 use Koha::CsvProfiles;
  40 use Koha::Patrons;
  41
  42 use C4::Koha;
  43
  44 use MARC::Field;
  45 use JSON qw( to_json );
  46
  47
  48 our (@ISA, @EXPORT_OK);
  49 BEGIN {
  50     require Exporter;
  51     @ISA       = qw(Exporter);
  52     @EXPORT_OK = qw(
  53       GetBasket NewBasket ReopenBasket ModBasket
  54       GetBasketAsCSV GetBasketGroupAsCSV
  55       GetBasketsByBookseller GetBasketsByBasketgroup
  56       GetBasketsInfosByBookseller
  57
  58       GetBasketUsers ModBasketUsers
  59       CanUserManageBasket
  60
  61       ModBasketHeader
  62
  63       ModBasketgroup NewBasketgroup DelBasketgroup GetBasketgroup CloseBasketgroup
  64       GetBasketgroups ReOpenBasketgroup
  65
  66       ModOrder GetOrder GetOrders GetOrdersByBiblionumber
  67       GetOrderFromItemnumber
  68       SearchOrders GetHistory GetRecentAcqui
  69       ModReceiveOrder CancelReceipt
  70       TransferOrder
  71       ModItemOrder
  72
  73       GetParcels
  74
  75       GetInvoices
  76       GetInvoice
  77       GetInvoiceDetails
  78       AddInvoice
  79       ModInvoice
  80       CloseInvoice
  81       ReopenInvoice
  82       DelInvoice
  83       MergeInvoices
  84
  85       AddClaim
  86       GetBiblioCountByBasketno
  87
  88       GetOrderUsers
  89       ModOrderUsers
  90       NotifyOrderUsers
  91
  92       FillWithDefaultValues
  93
  94       get_rounded_price
  95       get_rounding_sql
  96     );
  97 }
  98
  99
 100
 101
 102
 103 sub GetOrderFromItemnumber {
 104     my ($itemnumber) = @_;
 105     my $dbh          = C4::Context->dbh;
 106     my $query        = qq|
 107
 108     SELECT  * from aqorders    LEFT JOIN aqorders_items
 109     ON (     aqorders.ordernumber = aqorders_items.ordernumber   )
 110     WHERE itemnumber = ?  |;
 111
 112     my $sth = $dbh->prepare($query);
 113
 114 #    $sth->trace(3);
 115
 116     $sth->execute($itemnumber);
 117
 118     my $order = $sth->fetchrow_hashref;
 119     return ( $order  );
 120
 121 }
 122
 123 =head1 NAME
 124
 125 C4::Acquisition - Koha functions for dealing with orders and acquisitions
 126
 127 =head1 SYNOPSIS
 128
 129 use C4::Acquisition;
 130
 131 =head1 DESCRIPTION
 132
 133 The functions in this module deal with acquisitions, managing book
 134 orders, basket and parcels.
 135
 136 =head1 FUNCTIONS
 137
 138 =head2 FUNCTIONS ABOUT BASKETS
 139
 140 =head3 GetBasket
 141
 142   $aqbasket = &GetBasket($basketnumber);
 143
 144 get all basket informations in aqbasket for a given basket
 145
 146 B<returns:> informations for a given basket returned as a hashref.
 147
 148 =cut
 149
 150 sub GetBasket {
 151     my ($basketno) = @_;
 152     my $dbh        = C4::Context->dbh;
 153     my $query = "
 154         SELECT  aqbasket.*,
 155                 concat( b.firstname,' ',b.surname) AS authorisedbyname
 156         FROM    aqbasket
 157         LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
 158         WHERE basketno=?
 159     ";
 160     my $sth=$dbh->prepare($query);
 161     $sth->execute($basketno);
 162     my $basket = $sth->fetchrow_hashref;
 163     return ( $basket );
 164 }
 165
 166 #------------------------------------------------------------#
 167
 168 =head3 NewBasket
 169
 170   $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
 171       $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace, $is_standing, $create_items );
 172
 173 Create a new basket in aqbasket table
 174
 175 =over
 176
 177 =item C<$booksellerid> is a foreign key in the aqbasket table
 178
 179 =item C<$authorizedby> is the username of who created the basket
 180
 181 =back
 182
 183 The other parameters are optional, see ModBasketHeader for more info on them.
 184
 185 =cut
 186
 187 sub NewBasket {
 188     my ( $booksellerid, $authorisedby, $basketname, $basketnote,
 189         $basketbooksellernote, $basketcontractnumber, $deliveryplace,
 190         $billingplace, $is_standing, $create_items ) = @_;
 191     my $dbh = C4::Context->dbh;
 192     my $query =
 193         'INSERT INTO aqbasket (creationdate,booksellerid,authorisedby) '
 194       . 'VALUES  (now(),?,?)';
 195     $dbh->do( $query, {}, $booksellerid, $authorisedby );
 196
 197     my $basket = $dbh->{mysql_insertid};
 198     $basketname           ||= q{}; # default to empty strings
 199     $basketnote           ||= q{};
 200     $basketbooksellernote ||= q{};
 201
 202     # Log the basket creation
 203     if (C4::Context->preference("AcquisitionLog")) {
 204         my $created = Koha::Acquisition::Baskets->find( $basket );
 205         logaction(
 206             'ACQUISITIONS',
 207             'ADD_BASKET',
 208             $basket,
 209             to_json($created->unblessed)
 210         );
 211     }
 212
 213     ModBasketHeader( $basket, $basketname, $basketnote, $basketbooksellernote,
 214         $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items );
 215
 216     return $basket;
 217 }
 218
 219 =head3 ReopenBasket
 220
 221   &ReopenBasket($basketno);
 222
 223 reopen a basket
 224
 225 =cut
 226
 227 sub ReopenBasket {
 228     my ($basketno) = @_;
 229     my $dbh        = C4::Context->dbh;
 230     $dbh->do( q{UPDATE aqbasket SET closedate=NULL WHERE  basketno=?}, {}, $basketno );
 231
 232     $dbh->do( q{
 233         UPDATE aqorders
 234         SET orderstatus = 'new'
 235         WHERE basketno = ?
 236         AND orderstatus NOT IN ( 'complete', 'cancelled' )
 237         }, {}, $basketno);
 238
 239     # Log the basket reopening
 240     if (C4::Context->preference("AcquisitionLog")) {
 241         my $reopened = Koha::Acquisition::Baskets->find( $basketno );
 242         logaction(
 243             'ACQUISITIONS',
 244             'REOPEN_BASKET',
 245             $basketno,
 246             to_json($reopened->unblessed)
 247         );
 248     }
 249     return;
 250 }
 251
 252 #------------------------------------------------------------#
 253
 254 =head3 GetBasketAsCSV
 255
 256   &GetBasketAsCSV($basketno);
 257
 258 Export a basket as CSV
 259
 260 $cgi parameter is needed for column name translation
 261
 262 =cut
 263
 264 sub GetBasketAsCSV {
 265     my ($basketno, $cgi, $csv_profile_id) = @_;
 266     my $basket = GetBasket($basketno);
 267     my @orders = GetOrders($basketno);
 268     my $contract = GetContract({
 269         contractnumber => $basket->{'contractnumber'}
 270     });
 271
 272     my $template = C4::Templates::gettemplate("acqui/csv/basket.tt", "intranet", $cgi);
 273     my @rows;
 274     if ($csv_profile_id) {
 275         my $csv_profile = Koha::CsvProfiles->find( $csv_profile_id );
 276         Koha::Exceptions::ObjectNotFound->throw( 'There is no valid csv profile given') unless $csv_profile;
 277
 278         my $delimiter = $csv_profile->csv_separator;
 279         $delimiter = "\t" if $delimiter eq "\\t";
 280         my $csv = Text::CSV_XS->new({'quote_char'=>'"','escape_char'=>'"','sep_char'=>$delimiter,'binary'=>1});
 281         my $csv_profile_content = $csv_profile->content;
 282         my ( @headers, @fields );
 283         while ( $csv_profile_content =~ /
 284             ([^=\|]+) # header
 285             =?
 286             ([^\|]*) # fieldname (table.row or row)
 287             \|? /gxms
 288         ) {
 289             my $header = $1;
 290             my $field = ($2 eq '') ? $1 : $2;
 291
 292             $header =~ s/^\s+|\s+$//g; # Trim whitespaces
 293             push @headers, $header;
 294
 295             $field =~ s/[^\.]*\.{1}//; # Remove the table name if exists.
 296             $field =~ s/^\s+|\s+$//g; # Trim whitespaces
 297             push @fields, $field;
 298         }
 299         for my $order (@orders) {
 300             my @row;
 301             my $biblio = Koha::Biblios->find( $order->{biblionumber} );
 302             my $biblioitem = $biblio->biblioitem;
 303             $order = { %$order, %{ $biblioitem->unblessed } };
 304             if ($contract) {
 305                 $order = {%$order, %$contract};
 306             }
 307             $order = {%$order, %$basket, %{ $biblio->unblessed }};
 308             for my $field (@fields) {
 309                 push @row, $order->{$field};
 310             }
 311             push @rows, \@row;
 312         }
 313         my $content = join( $delimiter, @headers ) . "\n";
 314         for my $row ( @rows ) {
 315             $csv->combine(@$row);
 316             my $string = $csv->string;
 317             $content .= $string . "\n";
 318         }
 319         return $content;
 320     }
 321     else {
 322         foreach my $order (@orders) {
 323             my $biblio = Koha::Biblios->find( $order->{biblionumber} );
 324             my $biblioitem;
 325             if ($biblio) {
 326                 $biblioitem = $biblio->biblioitem;
 327             }
 328             my $row = {
 329                 contractname    => $contract->{'contractname'},
 330                 ordernumber     => $order->{'ordernumber'},
 331                 entrydate       => $order->{'entrydate'},
 332                 isbn            => $order->{'isbn'},
 333                 author          => $biblio     ? $biblio->author              : q{},
 334                 title           => $biblio     ? $biblio->title               : q{},
 335                 publicationyear => $biblioitem ? $biblioitem->publicationyear : q{},
 336                 publishercode   => $biblioitem ? $biblioitem->publishercode   : q{},
 337                 collectiontitle => $biblioitem ? $biblioitem->collectiontitle : q{},
 338                 notes           => $order->{'order_vendornote'},
 339                 quantity        => $order->{'quantity'},
 340                 rrp             => $order->{'rrp'},
 341             };
 342             for my $place ( qw( deliveryplace billingplace ) ) {
 343                 if ( my $library = Koha::Libraries->find( $row->{deliveryplace} ) ) {
 344                     $row->{$place} = $library->branchname
 345                 }
 346             }
 347             foreach(qw(
 348                 contractname author title publishercode collectiontitle notes
 349                 deliveryplace billingplace
 350             ) ) {
 351                 # Double the quotes to not be interpreted as a field end
 352                 $row->{$_} =~ s/"/""/g if $row->{$_};
 353             }
 354             push @rows, $row;
 355          }
 356
 357         @rows = sort {
 358             if(defined $a->{publishercode} and defined $b->{publishercode}) {
 359                 $a->{publishercode} cmp $b->{publishercode};
 360             }
 361         } @rows;
 362
 363         $template->param(rows => \@rows);
 364
 365         return $template->output;
 366     }
 367 }
 368
 369
 370 =head3 GetBasketGroupAsCSV
 371
 372   &GetBasketGroupAsCSV($basketgroupid);
 373
 374 Export a basket group as CSV
 375
 376 $cgi parameter is needed for column name translation
 377
 378 =cut
 379
 380 sub GetBasketGroupAsCSV {
 381     my ($basketgroupid, $cgi) = @_;
 382     my $baskets = GetBasketsByBasketgroup($basketgroupid);
 383
 384     my $template = C4::Templates::gettemplate('acqui/csv/basketgroup.tt', 'intranet', $cgi);
 385
 386     my @rows;
 387     for my $basket (@$baskets) {
 388         my @orders     = GetOrders( $basket->{basketno} );
 389         my $contract   = GetContract({
 390             contractnumber => $basket->{contractnumber}
 391         });
 392         my $bookseller = Koha::Acquisition::Booksellers->find( $basket->{booksellerid} );
 393         my $basketgroup = GetBasketgroup( $$basket{basketgroupid} );
 394
 395         foreach my $order (@orders) {
 396             my $biblio = Koha::Biblios->find( $order->{biblionumber} );
 397             my $biblioitem;
 398             if ($biblio) {
 399                 $biblioitem = $biblio->biblioitem;
 400             }
 401             my $row = {
 402                 clientnumber       => $bookseller->accountnumber,
 403                 basketname         => $basket->{basketname},
 404                 ordernumber        => $order->{ordernumber},
 405                 author             => $biblio     ? $biblio->author              : q{},
 406                 title              => $biblio     ? $biblio->title               : q{},
 407                 publishercode      => $biblioitem ? $biblioitem->publishercode   : q{},
 408                 publicationyear    => $biblioitem ? $biblioitem->publicationyear : q{},
 409                 collectiontitle    => $biblioitem ? $biblioitem->collectiontitle : q{},
 410                 isbn               => $order->{isbn},
 411                 quantity           => $order->{quantity},
 412                 rrp_tax_included   => $order->{rrp_tax_included},
 413                 rrp_tax_excluded   => $order->{rrp_tax_excluded},
 414                 discount           => $bookseller->discount,
 415                 ecost_tax_included => $order->{ecost_tax_included},
 416                 ecost_tax_excluded => $order->{ecost_tax_excluded},
 417                 notes              => $order->{order_vendornote},
 418                 entrydate          => $order->{entrydate},
 419                 booksellername     => $bookseller->name,
 420                 bookselleraddress  => $bookseller->address1,
 421                 booksellerpostal   => $bookseller->postal,
 422                 contractnumber     => $contract->{contractnumber},
 423                 contractname       => $contract->{contractname},
 424             };
 425             my $temp = {
 426                 basketgroupdeliveryplace => $basketgroup->{deliveryplace},
 427                 basketgroupbillingplace  => $basketgroup->{billingplace},
 428                 basketdeliveryplace      => $basket->{deliveryplace},
 429                 basketbillingplace       => $basket->{billingplace},
 430             };
 431             for my $place (qw( basketgroupdeliveryplace basketgroupbillingplace basketdeliveryplace basketbillingplace )) {
 432                 if ( my $library = Koha::Libraries->find( $temp->{$place} ) ) {
 433                     $row->{$place} = $library->branchname;
 434                 }
 435             }
 436             foreach(qw(
 437                 basketname author title publishercode collectiontitle notes
 438                 booksellername bookselleraddress booksellerpostal contractname
 439                 basketgroupdeliveryplace basketgroupbillingplace
 440                 basketdeliveryplace basketbillingplace
 441             ) ) {
 442                 # Double the quotes to not be interpreted as a field end
 443                 $row->{$_} =~ s/"/""/g if $row->{$_};
 444             }
 445             push @rows, $row;
 446          }
 447      }
 448     $template->param(rows => \@rows);
 449
 450     return $template->output;
 451
 452 }
 453
 454 =head3 CloseBasketgroup
 455
 456   &CloseBasketgroup($basketgroupno);
 457
 458 close a basketgroup
 459
 460 =cut
 461
 462 sub CloseBasketgroup {
 463     my ($basketgroupno) = @_;
 464     my $dbh        = C4::Context->dbh;
 465     my $sth = $dbh->prepare("
 466         UPDATE aqbasketgroups
 467         SET    closed=1
 468         WHERE  id=?
 469     ");
 470     $sth->execute($basketgroupno);
 471 }
 472
 473 #------------------------------------------------------------#
 474
 475 =head3 ReOpenBaskergroup($basketgroupno)
 476
 477   &ReOpenBaskergroup($basketgroupno);
 478
 479 reopen a basketgroup
 480
 481 =cut
 482
 483 sub ReOpenBasketgroup {
 484     my ($basketgroupno) = @_;
 485     my $dbh        = C4::Context->dbh;
 486     my $sth = $dbh->prepare("
 487         UPDATE aqbasketgroups
 488         SET    closed=0
 489         WHERE  id=?
 490     ");
 491     $sth->execute($basketgroupno);
 492 }
 493
 494 #------------------------------------------------------------#
 495
 496 =head3 ModBasket
 497
 498   &ModBasket($basketinfo);
 499
 500 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
 501
 502 =over
 503
 504 =item C<$basketno> is the primary key of the basket in the aqbasket table.
 505
 506 =back
 507
 508 =cut
 509
 510 sub ModBasket {
 511     my $basketinfo = shift;
 512     my $query = "UPDATE aqbasket SET ";
 513     my @params;
 514     foreach my $key (keys %$basketinfo){
 515         if ($key ne 'basketno'){
 516             $query .= "$key=?, ";
 517             push(@params, $basketinfo->{$key} || undef );
 518         }
 519     }
 520 # get rid of the "," at the end of $query
 521     if (substr($query, length($query)-2) eq ', '){
 522         chop($query);
 523         chop($query);
 524         $query .= ' ';
 525     }
 526     $query .= "WHERE basketno=?";
 527     push(@params, $basketinfo->{'basketno'});
 528     my $dbh = C4::Context->dbh;
 529     my $sth = $dbh->prepare($query);
 530     $sth->execute(@params);
 531
 532     # Log the basket update
 533     if (C4::Context->preference("AcquisitionLog")) {
 534         my $modified = Koha::Acquisition::Baskets->find(
 535             $basketinfo->{basketno}
 536         );
 537         logaction(
 538             'ACQUISITIONS',
 539             'MODIFY_BASKET',
 540             $basketinfo->{basketno},
 541             to_json($modified->unblessed)
 542         );
 543     }
 544
 545     return;
 546 }
 547
 548 #------------------------------------------------------------#
 549
 550 =head3 ModBasketHeader
 551
 552   &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
 553
 554 Modifies a basket's header.
 555
 556 =over
 557
 558 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
 559
 560 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
 561
 562 =item C<$note> is the "note" field in the "aqbasket" table;
 563
 564 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
 565
 566 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
 567
 568 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
 569
 570 =item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
 571
 572 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
 573
 574 =item C<$is_standing> is the "is_standing" field in the aqbasket table.
 575
 576 =item C<$create_items> should be set to 'ordering', 'receiving' or 'cataloguing' (or undef, in which
 577 case the AcqCreateItem syspref takes precedence).
 578
 579 =back
 580
 581 =cut
 582
 583 sub ModBasketHeader {
 584     my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items) = @_;
 585
 586     $is_standing ||= 0;
 587     my $query = qq{
 588         UPDATE aqbasket
 589         SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=?, is_standing=?, create_items=?
 590         WHERE basketno=?
 591     };
 592
 593     my $dbh = C4::Context->dbh;
 594     my $sth = $dbh->prepare($query);
 595     $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items || undef, $basketno);
 596
 597     if ( $contractnumber ) {
 598         my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
 599         my $sth2 = $dbh->prepare($query2);
 600         $sth2->execute($contractnumber,$basketno);
 601     }
 602
 603     # Log the basket update
 604     if (C4::Context->preference("AcquisitionLog")) {
 605         my $modified = Koha::Acquisition::Baskets->find(
 606             $basketno
 607         );
 608         logaction(
 609             'ACQUISITIONS',
 610             'MODIFY_BASKET_HEADER',
 611             $basketno,
 612             to_json($modified->unblessed)
 613         );
 614     }
 615
 616     return;
 617 }
 618
 619 #------------------------------------------------------------#
 620
 621 =head3 GetBasketsByBookseller
 622
 623   @results = &GetBasketsByBookseller($booksellerid, $extra);
 624
 625 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
 626
 627 =over
 628
 629 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
 630
 631 =item C<$extra> is the extra sql parameters, can be
 632
 633  $extra->{groupby}: group baskets by column
 634     ex. $extra->{groupby} = aqbasket.basketgroupid
 635  $extra->{orderby}: order baskets by column
 636  $extra->{limit}: limit number of results (can be helpful for pagination)
 637
 638 =back
 639
 640 =cut
 641
 642 sub GetBasketsByBookseller {
 643     my ($booksellerid, $extra) = @_;
 644     my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
 645     if ($extra){
 646         if ($extra->{groupby}) {
 647             $query .= " GROUP by $extra->{groupby}";
 648         }
 649         if ($extra->{orderby}){
 650             $query .= " ORDER by $extra->{orderby}";
 651         }
 652         if ($extra->{limit}){
 653             $query .= " LIMIT $extra->{limit}";
 654         }
 655     }
 656     my $dbh = C4::Context->dbh;
 657     my $sth = $dbh->prepare($query);
 658     $sth->execute($booksellerid);
 659     return $sth->fetchall_arrayref({});
 660 }
 661
 662 =head3 GetBasketsInfosByBookseller
 663
 664     my $baskets = GetBasketsInfosByBookseller($supplierid, $allbaskets);
 665
 666 The optional second parameter allbaskets is a boolean allowing you to
 667 select all baskets from the supplier; by default only active baskets (open or
 668 closed but still something to receive) are returned.
 669
 670 Returns in a arrayref of hashref all about booksellers baskets, plus:
 671     total_biblios: Number of distinct biblios in basket
 672     total_items: Number of items in basket
 673     expected_items: Number of non-received items in basket
 674
 675 =cut
 676
 677 sub GetBasketsInfosByBookseller {
 678     my ($supplierid, $allbaskets) = @_;
 679
 680     return unless $supplierid;
 681
 682     my $dbh = C4::Context->dbh;
 683     my $query = q{
 684         SELECT aqbasket.basketno, aqbasket.basketname, aqbasket.note, aqbasket.booksellernote, aqbasket.contractnumber, aqbasket.creationdate, aqbasket.closedate, aqbasket.booksellerid, aqbasket.authorisedby, aqbasket.booksellerinvoicenumber, aqbasket.basketgroupid, aqbasket.deliveryplace, aqbasket.billingplace, aqbasket.branch, aqbasket.is_standing, aqbasket.create_items,
 685           SUM(aqorders.quantity) AS total_items,
 686           SUM(
 687             IF ( aqorders.orderstatus = 'cancelled', aqorders.quantity, 0 )
 688           ) AS total_items_cancelled,
 689           COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
 690           SUM(
 691             IF(aqorders.datereceived IS NULL
 692               AND aqorders.datecancellationprinted IS NULL
 693             , aqorders.quantity
 694             , 0)
 695           ) AS expected_items,
 696         SUM( aqorders.uncertainprice ) AS uncertainprices
 697         FROM aqbasket
 698           LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
 699         WHERE booksellerid = ?};
 700
 701     $query.=" GROUP BY aqbasket.basketno, aqbasket.basketname, aqbasket.note, aqbasket.booksellernote, aqbasket.contractnumber, aqbasket.creationdate, aqbasket.closedate, aqbasket.booksellerid, aqbasket.authorisedby, aqbasket.booksellerinvoicenumber, aqbasket.basketgroupid, aqbasket.deliveryplace, aqbasket.billingplace, aqbasket.branch, aqbasket.is_standing, aqbasket.create_items";
 702
 703     unless ( $allbaskets ) {
 704         # Don't show the basket if it's NOT CLOSED or is FULLY RECEIVED
 705         $query.=" HAVING (closedate IS NULL OR (
 706           SUM(
 707             IF(aqorders.datereceived IS NULL
 708               AND aqorders.datecancellationprinted IS NULL
 709             , aqorders.quantity
 710             , 0)
 711             ) > 0))"
 712     }
 713
 714     my $sth = $dbh->prepare($query);
 715     $sth->execute($supplierid);
 716     my $baskets = $sth->fetchall_arrayref({});
 717
 718     # Retrieve the number of biblios cancelled
 719     my $cancelled_biblios = $dbh->selectall_hashref( q|
 720         SELECT COUNT(DISTINCT(biblionumber)) AS total_biblios_cancelled, aqbasket.basketno
 721         FROM aqbasket
 722         LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
 723         WHERE booksellerid = ?
 724         AND aqorders.orderstatus = 'cancelled'
 725         GROUP BY aqbasket.basketno
 726     |, 'basketno', {}, $supplierid );
 727     map {
 728         $_->{total_biblios_cancelled} = $cancelled_biblios->{$_->{basketno}}{total_biblios_cancelled} || 0
 729     } @$baskets;
 730
 731     return $baskets;
 732 }
 733
 734 =head3 GetBasketUsers
 735
 736     $basketusers_ids = &GetBasketUsers($basketno);
 737
 738 Returns a list of all borrowernumbers that are in basket users list
 739
 740 =cut
 741
 742 sub GetBasketUsers {
 743     my $basketno = shift;
 744
 745     return unless $basketno;
 746
 747     my $query = qq{
 748         SELECT borrowernumber
 749         FROM aqbasketusers
 750         WHERE basketno = ?
 751     };
 752     my $dbh = C4::Context->dbh;
 753     my $sth = $dbh->prepare($query);
 754     $sth->execute($basketno);
 755     my $results = $sth->fetchall_arrayref( {} );
 756
 757     my @borrowernumbers;
 758     foreach (@$results) {
 759         push @borrowernumbers, $_->{'borrowernumber'};
 760     }
 761
 762     return @borrowernumbers;
 763 }
 764
 765 =head3 ModBasketUsers
 766
 767     my @basketusers_ids = (1, 2, 3);
 768     &ModBasketUsers($basketno, @basketusers_ids);
 769
 770 Delete all users from basket users list, and add users in C<@basketusers_ids>
 771 to this users list.
 772
 773 =cut
 774
 775 sub ModBasketUsers {
 776     my ($basketno, @basketusers_ids) = @_;
 777
 778     return unless $basketno;
 779
 780     my $dbh = C4::Context->dbh;
 781     my $query = qq{
 782         DELETE FROM aqbasketusers
 783         WHERE basketno = ?
 784     };
 785     my $sth = $dbh->prepare($query);
 786     $sth->execute($basketno);
 787
 788     $query = qq{
 789         INSERT INTO aqbasketusers (basketno, borrowernumber)
 790         VALUES (?, ?)
 791     };
 792     $sth = $dbh->prepare($query);
 793     foreach my $basketuser_id (@basketusers_ids) {
 794         $sth->execute($basketno, $basketuser_id);
 795     }
 796
 797     # Log the basket update
 798     if (C4::Context->preference("AcquisitionLog")) {
 799         logaction(
 800             'ACQUISITIONS',
 801             'MODIFY_BASKET_USERS',
 802             $basketno,
 803             to_json({
 804                 basketno    => $basketno,
 805                 basketusers => @basketusers_ids
 806             })
 807         );
 808     }
 809
 810     return;
 811 }
 812
 813 =head3 CanUserManageBasket
 814
 815     my $bool = CanUserManageBasket($borrower, $basket[, $userflags]);
 816     my $bool = CanUserManageBasket($borrowernumber, $basketno[, $userflags]);
 817
 818 Check if a borrower can manage a basket, according to system preference
 819 AcqViewBaskets, user permissions and basket properties (creator, users list,
 820 branch).
 821
 822 First parameter can be either a borrowernumber or a hashref as returned by
 823 Koha::Patron->unblessed
 824
 825 Second parameter can be either a basketno or a hashref as returned by
 826 C4::Acquisition::GetBasket.
 827
 828 The third parameter is optional. If given, it should be a hashref as returned
 829 by C4::Auth::getuserflags. If not, getuserflags is called.
 830
 831 If user is authorised to manage basket, returns 1.
 832 Otherwise returns 0.
 833
 834 =cut
 835
 836 sub CanUserManageBasket {
 837     my ($borrower, $basket, $userflags) = @_;
 838
 839     if (!ref $borrower) {
 840         # FIXME This needs to be replaced
 841         # We should not accept both scalar and array
 842         # Tests need to be updated
 843         $borrower = Koha::Patrons->find( $borrower )->unblessed;
 844     }
 845     if (!ref $basket) {
 846         $basket = GetBasket($basket);
 847     }
 848
 849     return 0 unless ($basket and $borrower);
 850
 851     my $borrowernumber = $borrower->{borrowernumber};
 852     my $basketno = $basket->{basketno};
 853
 854     my $AcqViewBaskets = C4::Context->preference('AcqViewBaskets');
 855
 856     if (!defined $userflags) {
 857         my $dbh = C4::Context->dbh;
 858         my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE borrowernumber = ?");
 859         $sth->execute($borrowernumber);
 860         my ($flags) = $sth->fetchrow_array;
 861         $sth->finish;
 862
 863         $userflags = C4::Auth::getuserflags($flags, $borrower->{userid}, $dbh);
 864     }
 865
 866     unless ($userflags->{superlibrarian}
 867     || (ref $userflags->{acquisition} && $userflags->{acquisition}->{order_manage_all})
 868     || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
 869     {
 870         if (not exists $userflags->{acquisition}) {
 871             return 0;
 872         }
 873
 874         if ( (ref $userflags->{acquisition} && !$userflags->{acquisition}->{order_manage})
 875         || (!ref $userflags->{acquisition} && !$userflags->{acquisition}) ) {
 876             return 0;
 877         }
 878
 879         if ($AcqViewBaskets eq 'user'
 880         && $basket->{authorisedby} != $borrowernumber
 881         && ! grep { $borrowernumber eq $_ } GetBasketUsers($basketno)) {
 882              return 0;
 883         }
 884
 885         if ($AcqViewBaskets eq 'branch' && defined $basket->{branch}
 886         && $basket->{branch} ne $borrower->{branchcode}) {
 887             return 0;
 888         }
 889     }
 890
 891     return 1;
 892 }
 893
 894 #------------------------------------------------------------#
 895
 896 =head3 GetBasketsByBasketgroup
 897
 898   $baskets = &GetBasketsByBasketgroup($basketgroupid);
 899
 900 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
 901
 902 =cut
 903
 904 sub GetBasketsByBasketgroup {
 905     my $basketgroupid = shift;
 906     my $query = qq{
 907         SELECT *, aqbasket.booksellerid as booksellerid
 908         FROM aqbasket
 909         LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?
 910     };
 911     my $dbh = C4::Context->dbh;
 912     my $sth = $dbh->prepare($query);
 913     $sth->execute($basketgroupid);
 914     return $sth->fetchall_arrayref({});
 915 }
 916
 917 #------------------------------------------------------------#
 918
 919 =head3 NewBasketgroup
 920
 921   $basketgroupid = NewBasketgroup(\%hashref);
 922
 923 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
 924
 925 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
 926
 927 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 928
 929 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 930
 931 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
 932
 933 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
 934
 935 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
 936
 937 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
 938
 939 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 940
 941 =cut
 942
 943 sub NewBasketgroup {
 944     my $basketgroupinfo = shift;
 945     die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
 946     my $query = "INSERT INTO aqbasketgroups (";
 947     my @params;
 948     foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
 949         if ( defined $basketgroupinfo->{$field} ) {
 950             $query .= "$field, ";
 951             push(@params, $basketgroupinfo->{$field});
 952         }
 953     }
 954     $query .= "booksellerid) VALUES (";
 955     foreach (@params) {
 956         $query .= "?, ";
 957     }
 958     $query .= "?)";
 959     push(@params, $basketgroupinfo->{'booksellerid'});
 960     my $dbh = C4::Context->dbh;
 961     my $sth = $dbh->prepare($query);
 962     $sth->execute(@params);
 963     my $basketgroupid = $dbh->{'mysql_insertid'};
 964     if( $basketgroupinfo->{'basketlist'} ) {
 965         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
 966             my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
 967             my $sth2 = $dbh->prepare($query2);
 968             $sth2->execute($basketgroupid, $basketno);
 969         }
 970     }
 971     return $basketgroupid;
 972 }
 973
 974 #------------------------------------------------------------#
 975
 976 =head3 ModBasketgroup
 977
 978   ModBasketgroup(\%hashref);
 979
 980 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
 981
 982 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
 983
 984 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 985
 986 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 987
 988 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
 989
 990 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
 991
 992 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
 993
 994 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
 995
 996 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 997
 998 =cut
 999
1000 sub ModBasketgroup {
1001     my $basketgroupinfo = shift;
1002     die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
1003     my $dbh = C4::Context->dbh;
1004     my $query = "UPDATE aqbasketgroups SET ";
1005     my @params;
1006     foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
1007         if ( defined $basketgroupinfo->{$field} ) {
1008             $query .= "$field=?, ";
1009             push(@params, $basketgroupinfo->{$field});
1010         }
1011     }
1012     chop($query);
1013     chop($query);
1014     $query .= " WHERE id=?";
1015     push(@params, $basketgroupinfo->{'id'});
1016     my $sth = $dbh->prepare($query);
1017     $sth->execute(@params);
1018
1019     $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
1020     $sth->execute($basketgroupinfo->{'id'});
1021
1022     if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
1023         $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
1024         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
1025             $sth->execute($basketgroupinfo->{'id'}, $basketno);
1026         }
1027     }
1028     return;
1029 }
1030
1031 #------------------------------------------------------------#
1032
1033 =head3 DelBasketgroup
1034
1035   DelBasketgroup($basketgroupid);
1036
1037 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
1038
1039 =over
1040
1041 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
1042
1043 =back
1044
1045 =cut
1046
1047 sub DelBasketgroup {
1048     my $basketgroupid = shift;
1049     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1050     my $query = "DELETE FROM aqbasketgroups WHERE id=?";
1051     my $dbh = C4::Context->dbh;
1052     my $sth = $dbh->prepare($query);
1053     $sth->execute($basketgroupid);
1054     return;
1055 }
1056
1057 #------------------------------------------------------------#
1058
1059
1060 =head2 FUNCTIONS ABOUT ORDERS
1061
1062 =head3 GetBasketgroup
1063
1064   $basketgroup = &GetBasketgroup($basketgroupid);
1065
1066 Returns a reference to the hash containing all information about the basketgroup.
1067
1068 =cut
1069
1070 sub GetBasketgroup {
1071     my $basketgroupid = shift;
1072     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1073     my $dbh = C4::Context->dbh;
1074     my $result_set = $dbh->selectall_arrayref(
1075         'SELECT * FROM aqbasketgroups WHERE id=?',
1076         { Slice => {} },
1077         $basketgroupid
1078     );
1079     return $result_set->[0];    # id is unique
1080 }
1081
1082 #------------------------------------------------------------#
1083
1084 =head3 GetBasketgroups
1085
1086   $basketgroups = &GetBasketgroups($booksellerid);
1087
1088 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
1089
1090 =cut
1091
1092 sub GetBasketgroups {
1093     my $booksellerid = shift;
1094     die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
1095     my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
1096     my $dbh = C4::Context->dbh;
1097     my $sth = $dbh->prepare($query);
1098     $sth->execute($booksellerid);
1099     return $sth->fetchall_arrayref({});
1100 }
1101
1102 #------------------------------------------------------------#
1103
1104 =head2 FUNCTIONS ABOUT ORDERS
1105
1106 =head3 GetOrders
1107
1108   @orders = &GetOrders( $basketno, { orderby => 'biblio.title', cancelled => 0|1 } );
1109
1110 Looks up the pending (non-cancelled) orders with the given basket
1111 number.
1112
1113 If cancelled is set, only cancelled orders will be returned.
1114
1115 =cut
1116
1117 sub GetOrders {
1118     my ( $basketno, $params ) = @_;
1119
1120     return () unless $basketno;
1121
1122     my $orderby = $params->{orderby};
1123     my $cancelled = $params->{cancelled} || 0;
1124
1125     my $dbh   = C4::Context->dbh;
1126     my $query = q|
1127         SELECT biblio.*,biblioitems.*,
1128                 aqorders.*,
1129                 aqbudgets.*,
1130         |;
1131     $query .= $cancelled
1132       ? q|
1133                 aqorders_transfers.ordernumber_to AS transferred_to,
1134                 aqorders_transfers.timestamp AS transferred_to_timestamp
1135     |
1136       : q|
1137                 aqorders_transfers.ordernumber_from AS transferred_from,
1138                 aqorders_transfers.timestamp AS transferred_from_timestamp
1139     |;
1140     $query .= q|
1141         FROM    aqorders
1142             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
1143             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
1144             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
1145     |;
1146     $query .= $cancelled
1147       ? q|
1148             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
1149     |
1150       : q|
1151             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1152
1153     |;
1154     $query .= q|
1155         WHERE   basketno=?
1156     |;
1157
1158     if ($cancelled) {
1159         $orderby ||= q|biblioitems.publishercode, biblio.title|;
1160         $query .= q|
1161             AND datecancellationprinted IS NOT NULL
1162         |;
1163     }
1164     else {
1165         $orderby ||=
1166           q|aqorders.datecancellationprinted desc, aqorders.timestamp desc|;
1167         $query .= q|
1168             AND datecancellationprinted IS NULL
1169         |;
1170     }
1171
1172     $query .= " ORDER BY $orderby";
1173     my $orders =
1174       $dbh->selectall_arrayref( $query, { Slice => {} }, $basketno );
1175     return @{$orders};
1176
1177 }
1178
1179 #------------------------------------------------------------#
1180
1181 =head3 GetOrdersByBiblionumber
1182
1183   @orders = &GetOrdersByBiblionumber($biblionumber);
1184
1185 Looks up the orders with linked to a specific $biblionumber, including
1186 cancelled orders and received orders.
1187
1188 return :
1189 C<@orders> is an array of references-to-hash, whose keys are the
1190 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
1191
1192 =cut
1193
1194 sub GetOrdersByBiblionumber {
1195     my $biblionumber = shift;
1196     return unless $biblionumber;
1197     my $dbh   = C4::Context->dbh;
1198     my $query  ="
1199         SELECT biblio.*,biblioitems.*,
1200                 aqorders.*,
1201                 aqbudgets.*
1202         FROM    aqorders
1203             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
1204             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
1205             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
1206         WHERE   aqorders.biblionumber=?
1207     ";
1208     my $result_set =
1209       $dbh->selectall_arrayref( $query, { Slice => {} }, $biblionumber );
1210     return @{$result_set};
1211
1212 }
1213
1214 #------------------------------------------------------------#
1215
1216 =head3 GetOrder
1217
1218   $order = &GetOrder($ordernumber);
1219
1220 Looks up an order by order number.
1221
1222 Returns a reference-to-hash describing the order. The keys of
1223 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1224
1225 =cut
1226
1227 sub GetOrder {
1228     my ($ordernumber) = @_;
1229     return unless $ordernumber;
1230
1231     my $dbh      = C4::Context->dbh;
1232     my $query = qq{SELECT
1233                 aqorders.*,
1234                 biblio.title,
1235                 biblio.author,
1236                 aqbasket.basketname,
1237                 borrowers.branchcode,
1238                 biblioitems.publicationyear,
1239                 biblio.copyrightdate,
1240                 biblioitems.editionstatement,
1241                 biblioitems.isbn,
1242                 biblioitems.ean,
1243                 biblio.seriestitle,
1244                 biblioitems.publishercode,
1245                 aqorders.rrp              AS unitpricesupplier,
1246                 aqorders.ecost            AS unitpricelib,
1247                 aqbudgets.budget_name     AS budget,
1248                 aqbooksellers.name        AS supplier,
1249                 aqbooksellers.id          AS supplierid,
1250                 biblioitems.publishercode AS publisher,
1251                 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS calculateddeliverydate,
1252                 DATE(aqbasket.closedate)  AS orderdate,
1253                 aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity_to_receive,
1254                 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1255                 DATEDIFF(CURDATE( ),closedate) AS latesince
1256                 FROM aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1257                 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1258                 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1259                 aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby = borrowers.borrowernumber
1260                 LEFT JOIN aqbooksellers       ON aqbasket.booksellerid = aqbooksellers.id
1261                 WHERE aqorders.basketno = aqbasket.basketno
1262                     AND ordernumber=?};
1263     my $result_set =
1264       $dbh->selectall_arrayref( $query, { Slice => {} }, $ordernumber );
1265
1266     # result_set assumed to contain 1 match
1267     return $result_set->[0];
1268 }
1269
1270 =head3 ModOrder
1271
1272   &ModOrder(\%hashref);
1273
1274 Modifies an existing order. Updates the order with order number
1275 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1276 other keys of the hash update the fields with the same name in the aqorders
1277 table of the Koha database.
1278
1279 =cut
1280
1281 sub ModOrder {
1282     my $orderinfo = shift;
1283
1284     die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '';
1285
1286     my $dbh = C4::Context->dbh;
1287     my @params;
1288
1289     # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1290     $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1291
1292 #    delete($orderinfo->{'branchcode'});
1293     # the hash contains a lot of entries not in aqorders, so get the columns ...
1294     my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1295     $sth->execute;
1296     my $colnames = $sth->{NAME};
1297         #FIXME Be careful. If aqorders would have columns with diacritics,
1298         #you should need to decode what you get back from NAME.
1299         #See report 10110 and guided_reports.pl
1300     my $query = "UPDATE aqorders SET ";
1301
1302     foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1303         # ... and skip hash entries that are not in the aqorders table
1304         # FIXME : probably not the best way to do it (would be better to have a correct hash)
1305         next unless grep { $_ eq $orderinfokey } @$colnames;
1306             $query .= "$orderinfokey=?, ";
1307             push(@params, $orderinfo->{$orderinfokey});
1308     }
1309
1310     $query .= "timestamp=NOW()  WHERE  ordernumber=?";
1311     push(@params, $orderinfo->{'ordernumber'} );
1312     $sth = $dbh->prepare($query);
1313     $sth->execute(@params);
1314     return;
1315 }
1316
1317 #------------------------------------------------------------#
1318
1319 =head3 ModItemOrder
1320
1321     ModItemOrder($itemnumber, $ordernumber);
1322
1323 Modifies the ordernumber of an item in aqorders_items.
1324
1325 =cut
1326
1327 sub ModItemOrder {
1328     my ($itemnumber, $ordernumber) = @_;
1329
1330     return unless ($itemnumber and $ordernumber);
1331
1332     my $dbh = C4::Context->dbh;
1333     my $query = qq{
1334         UPDATE aqorders_items
1335         SET ordernumber = ?
1336         WHERE itemnumber = ?
1337     };
1338     my $sth = $dbh->prepare($query);
1339     return $sth->execute($ordernumber, $itemnumber);
1340 }
1341
1342 #------------------------------------------------------------#
1343
1344 =head3 ModReceiveOrder
1345
1346     my ( $date_received, $new_ordernumber ) = ModReceiveOrder(
1347         {
1348             biblionumber         => $biblionumber,
1349             order                => $order,
1350             quantityreceived     => $quantityreceived,
1351             user                 => $user,
1352             invoice              => $invoice,
1353             budget_id            => $budget_id,
1354             datereceived         => $datereceived,
1355             received_itemnumbers => \@received_itemnumbers,
1356         }
1357     );
1358
1359 Updates an order, to reflect the fact that it was received, at least
1360 in part.
1361
1362 If a partial order is received, splits the order into two.
1363
1364 Updates the order with biblionumber C<$biblionumber> and ordernumber
1365 C<$order->{ordernumber}>.
1366
1367 =cut
1368
1369
1370 sub ModReceiveOrder {
1371     my ($params)       = @_;
1372     my $biblionumber   = $params->{biblionumber};
1373     my $order          = { %{ $params->{order} } }; # Copy the order, we don't want to modify it
1374     my $invoice        = $params->{invoice};
1375     my $quantrec       = $params->{quantityreceived};
1376     my $user           = $params->{user};
1377     my $budget_id      = $params->{budget_id};
1378     my $datereceived   = $params->{datereceived};
1379     my $received_items = $params->{received_items};
1380
1381     my $dbh = C4::Context->dbh;
1382     $datereceived = $datereceived ? dt_from_string( $datereceived ) : dt_from_string;
1383     $datereceived = $datereceived->ymd;
1384
1385     my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1386     if ($suggestionid) {
1387         ModSuggestion( {suggestionid=>$suggestionid,
1388                         STATUS=>'AVAILABLE',
1389                         biblionumber=> $biblionumber}
1390                         );
1391     }
1392
1393     my $result_set = $dbh->selectrow_arrayref(
1394             q{SELECT aqbasket.is_standing
1395             FROM aqbasket
1396             WHERE basketno=?},{ Slice => {} }, $order->{basketno});
1397     my $is_standing = $result_set->[0];  # we assume we have a unique basket
1398
1399     my $new_ordernumber = $order->{ordernumber};
1400     if ( $is_standing || $order->{quantity} > $quantrec ) {
1401         # Split order line in two parts: the first is the original order line
1402         # without received items (the quantity is decreased),
1403         # the second part is a new order line with quantity=quantityrec
1404         # (entirely received)
1405         my $query = q|
1406             UPDATE aqorders
1407             SET quantity = ?,
1408                 orderstatus = 'partial'|;
1409         $query .= q| WHERE ordernumber = ?|;
1410         my $sth = $dbh->prepare($query);
1411
1412         $sth->execute(
1413             ( $is_standing ? 1 : ($order->{quantity} - $quantrec) ),
1414             $order->{ordernumber}
1415         );
1416
1417         if ( not $order->{subscriptionid} && defined $order->{order_internalnote} ) {
1418             $dbh->do(
1419                 q|UPDATE aqorders
1420                 SET order_internalnote = ?
1421                 WHERE ordernumber = ?|, {},
1422                 $order->{order_internalnote}, $order->{ordernumber}
1423             );
1424         }
1425
1426         # Recalculate tax_value
1427         $dbh->do(q|
1428             UPDATE aqorders
1429             SET
1430                 tax_value_on_ordering = quantity * | . get_rounding_sql(q|ecost_tax_excluded|) . q| * tax_rate_on_ordering,
1431                 tax_value_on_receiving = quantity * | . get_rounding_sql(q|unitprice_tax_excluded|) . q| * tax_rate_on_receiving
1432             WHERE ordernumber = ?
1433         |, undef, $order->{ordernumber});
1434
1435         delete $order->{ordernumber};
1436         $order->{budget_id} = ( $budget_id || $order->{budget_id} );
1437         $order->{quantity} = $quantrec;
1438         $order->{quantityreceived} = $quantrec;
1439         $order->{ecost_tax_excluded} //= 0;
1440         $order->{tax_rate_on_ordering} //= 0;
1441         $order->{unitprice_tax_excluded} //= 0;
1442         $order->{tax_rate_on_receiving} //= 0;
1443         $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($order->{ecost_tax_excluded}) * $order->{tax_rate_on_ordering};
1444         $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
1445         $order->{datereceived} = $datereceived;
1446         $order->{invoiceid} = $invoice->{invoiceid};
1447         $order->{orderstatus} = 'complete';
1448         $new_ordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber; # TODO What if the store fails?
1449
1450         if ($received_items) {
1451             foreach my $itemnumber (@$received_items) {
1452                 ModItemOrder($itemnumber, $new_ordernumber);
1453             }
1454         }
1455     } else {
1456         my $query = q|
1457             UPDATE aqorders
1458             SET quantityreceived = ?,
1459                 datereceived = ?,
1460                 invoiceid = ?,
1461                 budget_id = ?,
1462                 orderstatus = 'complete'
1463         |;
1464
1465         $query .= q|
1466             , replacementprice = ?
1467         | if defined $order->{replacementprice};
1468
1469         $query .= q|
1470             , unitprice = ?, unitprice_tax_included = ?, unitprice_tax_excluded = ?
1471         | if defined $order->{unitprice};
1472
1473         $query .= q|
1474             ,tax_value_on_receiving = ?
1475         | if defined $order->{tax_value_on_receiving};
1476
1477         $query .= q|
1478             ,tax_rate_on_receiving = ?
1479         | if defined $order->{tax_rate_on_receiving};
1480
1481         $query .= q|
1482             , order_internalnote = ?
1483         | if defined $order->{order_internalnote};
1484
1485         $query .= q| where biblionumber=? and ordernumber=?|;
1486
1487         my $sth = $dbh->prepare( $query );
1488         my @params = ( $quantrec, $datereceived, $invoice->{invoiceid}, ( $budget_id ? $budget_id : $order->{budget_id} ) );
1489
1490         if ( defined $order->{replacementprice} ) {
1491             push @params, $order->{replacementprice};
1492         }
1493
1494         if ( defined $order->{unitprice} ) {
1495             push @params, $order->{unitprice}, $order->{unitprice_tax_included}, $order->{unitprice_tax_excluded};
1496         }
1497
1498         if ( defined $order->{tax_value_on_receiving} ) {
1499             push @params, $order->{tax_value_on_receiving};
1500         }
1501
1502         if ( defined $order->{tax_rate_on_receiving} ) {
1503             push @params, $order->{tax_rate_on_receiving};
1504         }
1505
1506         if ( defined $order->{order_internalnote} ) {
1507             push @params, $order->{order_internalnote};
1508         }
1509
1510         push @params, ( $biblionumber, $order->{ordernumber} );
1511
1512         $sth->execute( @params );
1513
1514         # All items have been received, sent a notification to users
1515         NotifyOrderUsers( $order->{ordernumber} );
1516
1517     }
1518     return ($datereceived, $new_ordernumber);
1519 }
1520
1521 =head3 CancelReceipt
1522
1523     my $parent_ordernumber = CancelReceipt($ordernumber);
1524
1525     Cancel an order line receipt and update the parent order line, as if no
1526     receipt was made.
1527     If items are created at receipt (AcqCreateItem = receiving) then delete
1528     these items.
1529
1530 =cut
1531
1532 sub CancelReceipt {
1533     my $ordernumber = shift;
1534
1535     return unless $ordernumber;
1536
1537     my $dbh = C4::Context->dbh;
1538     my $query = qq{
1539         SELECT datereceived, parent_ordernumber, quantity
1540         FROM aqorders
1541         WHERE ordernumber = ?
1542     };
1543     my $sth = $dbh->prepare($query);
1544     $sth->execute($ordernumber);
1545     my $order = $sth->fetchrow_hashref;
1546     unless($order) {
1547         warn "CancelReceipt: order $ordernumber does not exist";
1548         return;
1549     }
1550     unless($order->{'datereceived'}) {
1551         warn "CancelReceipt: order $ordernumber is not received";
1552         return;
1553     }
1554
1555     my $parent_ordernumber = $order->{'parent_ordernumber'};
1556
1557     my $order_obj = Koha::Acquisition::Orders->find( $ordernumber ); # FIXME rewrite all this subroutine using this object
1558     my @itemnumbers = $order_obj->items->get_column('itemnumber');
1559
1560     if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1561         # The order line has no parent, just mark it as not received
1562         $query = qq{
1563             UPDATE aqorders
1564             SET quantityreceived = ?,
1565                 datereceived = ?,
1566                 invoiceid = ?,
1567                 orderstatus = 'ordered'
1568             WHERE ordernumber = ?
1569         };
1570         $sth = $dbh->prepare($query);
1571         $sth->execute(0, undef, undef, $ordernumber);
1572         _cancel_items_receipt( $order_obj );
1573     } else {
1574         # The order line has a parent, increase parent quantity and delete
1575         # the order line.
1576         unless ( $order_obj->basket->is_standing ) {
1577             $query = qq{
1578                 SELECT quantity, datereceived
1579                 FROM aqorders
1580                 WHERE ordernumber = ?
1581             };
1582             $sth = $dbh->prepare($query);
1583             $sth->execute($parent_ordernumber);
1584             my $parent_order = $sth->fetchrow_hashref;
1585             unless($parent_order) {
1586                 warn "Parent order $parent_ordernumber does not exist.";
1587                 return;
1588             }
1589             if($parent_order->{'datereceived'}) {
1590                 warn "CancelReceipt: parent order is received.".
1591                     " Can't cancel receipt.";
1592                 return;
1593             }
1594             $query = qq{
1595                 UPDATE aqorders
1596                 SET quantity = ?,
1597                     orderstatus = 'ordered'
1598                 WHERE ordernumber = ?
1599             };
1600             $sth = $dbh->prepare($query);
1601             my $rv = $sth->execute(
1602                 $order->{'quantity'} + $parent_order->{'quantity'},
1603                 $parent_ordernumber
1604             );
1605             unless($rv) {
1606                 warn "Cannot update parent order line, so do not cancel".
1607                     " receipt";
1608                 return;
1609             }
1610
1611             # Recalculate tax_value
1612             $dbh->do(q|
1613                 UPDATE aqorders
1614                 SET
1615                     tax_value_on_ordering = quantity * | . get_rounding_sql(q|ecost_tax_excluded|) . q| * tax_rate_on_ordering,
1616                     tax_value_on_receiving = quantity * | . get_rounding_sql(q|unitprice_tax_excluded|) . q| * tax_rate_on_receiving
1617                 WHERE ordernumber = ?
1618             |, undef, $parent_ordernumber);
1619         }
1620
1621         _cancel_items_receipt( $order_obj, $parent_ordernumber );
1622         # Delete order line
1623         $query = qq{
1624             DELETE FROM aqorders
1625             WHERE ordernumber = ?
1626         };
1627         $sth = $dbh->prepare($query);
1628         $sth->execute($ordernumber);
1629
1630     }
1631
1632     if( $order_obj->basket->effective_create_items eq 'ordering' ) {
1633         my @affects = split q{\|}, C4::Context->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1634         if ( @affects ) {
1635             for my $in ( @itemnumbers ) {
1636                 my $item = Koha::Items->find( $in ); # FIXME We do not need that, we already have Koha::Items from $order_obj->items
1637                 my $biblio = $item->biblio;
1638                 my ( $itemfield ) = GetMarcFromKohaField( 'items.itemnumber' );
1639                 my $item_marc = C4::Items::GetMarcItem( $biblio->biblionumber, $in );
1640                 for my $affect ( @affects ) {
1641                     my ( $sf, $v ) = split q{=}, $affect, 2;
1642                     foreach ( $item_marc->field($itemfield) ) {
1643                         $_->update( $sf => $v );
1644                     }
1645                 }
1646                 C4::Items::ModItemFromMarc( $item_marc, $biblio->biblionumber, $in );
1647             }
1648         }
1649     }
1650
1651     return $parent_ordernumber;
1652 }
1653
1654 sub _cancel_items_receipt {
1655     my ( $order, $parent_ordernumber ) = @_;
1656     $parent_ordernumber ||= $order->ordernumber;
1657
1658     my $items = $order->items;
1659     if ( $order->basket->effective_create_items eq 'receiving' ) {
1660         # Remove items that were created at receipt
1661         my $query = qq{
1662             DELETE FROM items, aqorders_items
1663             USING items, aqorders_items
1664             WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1665         };
1666         my $dbh = C4::Context->dbh;
1667         my $sth = $dbh->prepare($query);
1668         while ( my $item = $items->next ) {
1669             $sth->execute($item->itemnumber, $item->itemnumber);
1670         }
1671     } else {
1672         # Update items
1673         while ( my $item = $items->next ) {
1674             ModItemOrder($item->itemnumber, $parent_ordernumber);
1675         }
1676     }
1677 }
1678
1679 #------------------------------------------------------------#
1680
1681 =head3 SearchOrders
1682
1683 @results = &SearchOrders({
1684     ordernumber => $ordernumber,
1685     search => $search,
1686     ean => $ean,
1687     booksellerid => $booksellerid,
1688     basketno => $basketno,
1689     basketname => $basketname,
1690     basketgroupname => $basketgroupname,
1691     owner => $owner,
1692     pending => $pending
1693     ordered => $ordered
1694     biblionumber => $biblionumber,
1695     budget_id => $budget_id
1696 });
1697
1698 Searches for orders filtered by criteria.
1699
1700 C<$ordernumber> Finds matching orders or transferred orders by ordernumber.
1701 C<$search> Finds orders matching %$search% in title, author, or isbn.
1702 C<$owner> Finds order for the logged in user.
1703 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1704 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1705
1706
1707 C<@results> is an array of references-to-hash with the keys are fields
1708 from aqorders, biblio, biblioitems and aqbasket tables.
1709
1710 =cut
1711
1712 sub SearchOrders {
1713     my ( $params ) = @_;
1714     my $ordernumber = $params->{ordernumber};
1715     my $search = $params->{search};
1716     my $ean = $params->{ean};
1717     my $booksellerid = $params->{booksellerid};
1718     my $basketno = $params->{basketno};
1719     my $basketname = $params->{basketname};
1720     my $basketgroupname = $params->{basketgroupname};
1721     my $owner = $params->{owner};
1722     my $pending = $params->{pending};
1723     my $ordered = $params->{ordered};
1724     my $biblionumber = $params->{biblionumber};
1725     my $budget_id = $params->{budget_id};
1726
1727     my $dbh = C4::Context->dbh;
1728     my @args = ();
1729     my $query = q{
1730         SELECT aqbasket.basketno,
1731                borrowers.surname,
1732                borrowers.firstname,
1733                biblio.*,
1734                biblioitems.isbn,
1735                biblioitems.biblioitemnumber,
1736                biblioitems.publishercode,
1737                biblioitems.publicationyear,
1738                aqbasket.authorisedby,
1739                aqbasket.booksellerid,
1740                aqbasket.closedate,
1741                aqbasket.creationdate,
1742                aqbasket.basketname,
1743                aqbasketgroups.id as basketgroupid,
1744                aqbasketgroups.name as basketgroupname,
1745                aqorders.*
1746         FROM aqorders
1747             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1748             LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1749             LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1750             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1751             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1752     };
1753
1754     # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
1755     $query .= q{
1756             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1757     } if $ordernumber;
1758
1759     $query .= q{
1760         WHERE (datecancellationprinted is NULL)
1761     };
1762
1763     if ( $pending or $ordered ) {
1764         $query .= q{
1765             AND (
1766                 ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) )
1767                 OR (
1768                     ( quantity > quantityreceived OR quantityreceived is NULL )
1769         };
1770
1771         if ( $ordered ) {
1772             $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1773         }
1774         $query .= q{
1775                 )
1776             )
1777         };
1778     }
1779
1780     my $userenv = C4::Context->userenv;
1781     if ( C4::Context->preference("IndependentBranches") ) {
1782         unless ( C4::Context->IsSuperLibrarian() ) {
1783             $query .= q{
1784                 AND (
1785                     borrowers.branchcode = ?
1786                     OR borrowers.branchcode  = ''
1787                 )
1788             };
1789             push @args, $userenv->{branch};
1790         }
1791     }
1792
1793     if ( $ordernumber ) {
1794         $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1795         push @args, ( $ordernumber, $ordernumber );
1796     }
1797     if ( $biblionumber ) {
1798         $query .= 'AND aqorders.biblionumber = ?';
1799         push @args, $biblionumber;
1800     }
1801     if( $search ) {
1802         $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1803         push @args, ("%$search%","%$search%","%$search%");
1804     }
1805     if ( $ean ) {
1806         $query .= ' AND biblioitems.ean = ?';
1807         push @args, $ean;
1808     }
1809     if ( $booksellerid ) {
1810         $query .= 'AND aqbasket.booksellerid = ?';
1811         push @args, $booksellerid;
1812     }
1813     if( $basketno ) {
1814         $query .= 'AND aqbasket.basketno = ?';
1815         push @args, $basketno;
1816     }
1817     if( $basketname ) {
1818         $query .= 'AND aqbasket.basketname LIKE ?';
1819         push @args, "%$basketname%";
1820     }
1821     if( $basketgroupname ) {
1822         $query .= ' AND aqbasketgroups.name LIKE ?';
1823         push @args, "%$basketgroupname%";
1824     }
1825
1826     if ( $owner ) {
1827         $query .= ' AND aqbasket.authorisedby=? ';
1828         push @args, $userenv->{'number'};
1829     }
1830
1831     if ( $budget_id ) {
1832         $query .= ' AND aqorders.budget_id = ?';
1833         push @args, $budget_id;
1834     }
1835
1836     $query .= ' ORDER BY aqbasket.basketno';
1837
1838     my $sth = $dbh->prepare($query);
1839     $sth->execute(@args);
1840     return $sth->fetchall_arrayref({});
1841 }
1842
1843 #------------------------------------------------------------#
1844
1845 =head3 TransferOrder
1846
1847     my $newordernumber = TransferOrder($ordernumber, $basketno);
1848
1849 Transfer an order line to a basket.
1850 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1851 to BOOKSELLER on DATE' and create new order with internal note
1852 'Transferred from BOOKSELLER on DATE'.
1853 Move all attached items to the new order.
1854 Received orders cannot be transferred.
1855 Return the ordernumber of created order.
1856
1857 =cut
1858
1859 sub TransferOrder {
1860     my ($ordernumber, $basketno) = @_;
1861
1862     return unless ($ordernumber and $basketno);
1863
1864     my $order = Koha::Acquisition::Orders->find( $ordernumber ) or return;
1865     return if $order->datereceived;
1866
1867     $order = $order->unblessed;
1868
1869     my $basket = GetBasket($basketno);
1870     return unless $basket;
1871
1872     my $dbh = C4::Context->dbh;
1873     my ($query, $sth, $rv);
1874
1875     $query = q{
1876         UPDATE aqorders
1877         SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1878         WHERE ordernumber = ?
1879     };
1880     $sth = $dbh->prepare($query);
1881     $rv = $sth->execute('cancelled', $ordernumber);
1882
1883     delete $order->{'ordernumber'};
1884     delete $order->{parent_ordernumber};
1885     $order->{'basketno'} = $basketno;
1886
1887     my $newordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber;
1888
1889     $query = q{
1890         UPDATE aqorders_items
1891         SET ordernumber = ?
1892         WHERE ordernumber = ?
1893     };
1894     $sth = $dbh->prepare($query);
1895     $sth->execute($newordernumber, $ordernumber);
1896
1897     $query = q{
1898         INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1899         VALUES (?, ?)
1900     };
1901     $sth = $dbh->prepare($query);
1902     $sth->execute($ordernumber, $newordernumber);
1903
1904     return $newordernumber;
1905 }
1906
1907 =head3 get_rounding_sql
1908
1909     $rounding_sql = get_rounding_sql($column_name);
1910
1911 returns the correct SQL routine based on OrderPriceRounding system preference.
1912
1913 =cut
1914
1915 sub get_rounding_sql {
1916     my ( $round_string ) = @_;
1917     my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
1918     if ( $rounding_pref eq "nearest_cent"  ) {
1919         return "CAST($round_string*100 AS SIGNED)/100";
1920     }
1921     return $round_string;
1922 }
1923
1924 =head3 get_rounded_price
1925
1926     $rounded_price = get_rounded_price( $price );
1927
1928 returns a price rounded as specified in OrderPriceRounding system preference.
1929
1930 =cut
1931
1932 sub get_rounded_price {
1933     my ( $price ) =  @_;
1934     my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
1935     if( $rounding_pref eq 'nearest_cent' ) {
1936         return Koha::Number::Price->new( $price )->round();
1937     }
1938     return $price;
1939 }
1940
1941
1942 =head2 FUNCTIONS ABOUT PARCELS
1943
1944 =head3 GetParcels
1945
1946   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1947
1948 get a lists of parcels.
1949
1950 * Input arg :
1951
1952 =over
1953
1954 =item $bookseller
1955 is the bookseller this function has to get parcels.
1956
1957 =item $order
1958 To know on what criteria the results list has to be ordered.
1959
1960 =item $code
1961 is the booksellerinvoicenumber.
1962
1963 =item $datefrom & $dateto
1964 to know on what date this function has to filter its search.
1965
1966 =back
1967
1968 * return:
1969 a pointer on a hash list containing parcel informations as such :
1970
1971 =over
1972
1973 =item Creation date
1974
1975 =item Last operation
1976
1977 =item Number of biblio
1978
1979 =item Number of items
1980
1981 =back
1982
1983 =cut
1984
1985 sub GetParcels {
1986     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1987     my $dbh    = C4::Context->dbh;
1988     my @query_params = ();
1989     my $strsth ="
1990         SELECT  aqinvoices.invoicenumber,
1991                 datereceived,purchaseordernumber,
1992                 count(DISTINCT biblionumber) AS biblio,
1993                 sum(quantity) AS itemsexpected,
1994                 sum(quantityreceived) AS itemsreceived
1995         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1996         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1997         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1998     ";
1999     push @query_params, $bookseller;
2000
2001     if ( defined $code ) {
2002         $strsth .= ' and aqinvoices.invoicenumber like ? ';
2003         # add a % to the end of the code to allow stemming.
2004         push @query_params, "$code%";
2005     }
2006
2007     if ( defined $datefrom ) {
2008         $strsth .= ' and datereceived >= ? ';
2009         push @query_params, $datefrom;
2010     }
2011
2012     if ( defined $dateto ) {
2013         $strsth .=  'and datereceived <= ? ';
2014         push @query_params, $dateto;
2015     }
2016
2017     $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
2018
2019     # can't use a placeholder to place this column name.
2020     # but, we could probably be checking to make sure it is a column that will be fetched.
2021     $strsth .= "order by $order " if ($order);
2022
2023     my $sth = $dbh->prepare($strsth);
2024
2025     $sth->execute( @query_params );
2026     my $results = $sth->fetchall_arrayref({});
2027     return @{$results};
2028 }
2029
2030 #------------------------------------------------------------#
2031
2032 =head3 GetHistory
2033
2034   \@order_loop = GetHistory( %params );
2035
2036 Retreives some acquisition history information
2037
2038 params:
2039   title
2040   author
2041   name
2042   isbn
2043   ean
2044   from_placed_on
2045   to_placed_on
2046   basket                  - search both basket name and number
2047   booksellerinvoicenumber
2048   basketgroupname
2049   budget
2050   orderstatus (note that orderstatus '' will retrieve orders
2051                of any status except cancelled)
2052   is_standing
2053   managing_library
2054   biblionumber
2055   get_canceled_order (if set to a true value, cancelled orders will
2056                       be included)
2057
2058 returns:
2059     $order_loop is a list of hashrefs that each look like this:
2060             {
2061                 'author'           => 'Twain, Mark',
2062                 'basketno'         => '1',
2063                 'biblionumber'     => '215',
2064                 'count'            => 1,
2065                 'creationdate'     => 'MM/DD/YYYY',
2066                 'datereceived'     => undef,
2067                 'ecost'            => '1.00',
2068                 'id'               => '1',
2069                 'invoicenumber'    => undef,
2070                 'name'             => '',
2071                 'ordernumber'      => '1',
2072                 'quantity'         => 1,
2073                 'quantityreceived' => undef,
2074                 'title'            => 'The Adventures of Huckleberry Finn',
2075                 'managing_library' => 'CPL'
2076                 'is_standing'      => '1'
2077             }
2078
2079 =cut
2080
2081 sub GetHistory {
2082 # don't run the query if there are no parameters (list would be too long for sure !)
2083     croak "No search params" unless @_;
2084     my %params = @_;
2085     my $title = $params{title};
2086     my $author = $params{author};
2087     my $isbn   = $params{isbn};
2088     my $issn   = $params{issn};
2089     my $ean    = $params{ean};
2090     my $name = $params{name};
2091     my $internalnote = $params{internalnote};
2092     my $vendornote = $params{vendornote};
2093     my $from_placed_on = $params{from_placed_on};
2094     my $to_placed_on = $params{to_placed_on};
2095     my $basket = $params{basket};
2096     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2097     my $basketgroupname = $params{basketgroupname};
2098     my $budget = $params{budget};
2099     my $orderstatus = $params{orderstatus};
2100     my $is_standing = $params{is_standing};
2101     my $biblionumber = $params{biblionumber};
2102     my $get_canceled_order = $params{get_canceled_order} || 0;
2103     my $ordernumber = $params{ordernumber};
2104     my $search_children_too = $params{search_children_too} || 0;
2105     my $created_by = $params{created_by} || [];
2106     my $managing_library = $params{managing_library};
2107     my $ordernumbers = $params{ordernumbers} || [];
2108     my $additional_fields = $params{additional_fields} // [];
2109
2110     my $total_qty         = 0;
2111     my $total_qtyreceived = 0;
2112     my $total_price       = 0;
2113
2114     #get variation of isbn
2115     my @isbn_params;
2116     my @isbns;
2117     if ($isbn){
2118         if ( C4::Context->preference("SearchWithISBNVariations") ){
2119             @isbns = C4::Koha::GetVariationsOfISBN( $isbn );
2120             foreach my $isb (@isbns){
2121                 push @isbn_params, '?';
2122             }
2123         }
2124         unless (@isbns){
2125             push @isbns, $isbn;
2126             push @isbn_params, '?';
2127         }
2128     }
2129
2130     #get variation of issn
2131     my @issn_params;
2132     my @issns;
2133     if ($issn){
2134         if ( C4::Context->preference("SearchWithISSNVariations") ){
2135             @issns = C4::Koha::GetVariationsOfISSN( $issn );
2136             push @issn_params, ('?') x @issns;
2137         }
2138         unless (@issns){
2139             push @issns, $issn;
2140             push @issn_params, '?';
2141         }
2142     }
2143
2144     my $dbh   = C4::Context->dbh;
2145     my $query ="
2146         SELECT
2147             COALESCE(biblio.title,     deletedbiblio.title)     AS title,
2148             COALESCE(biblio.author,    deletedbiblio.author)    AS author,
2149             COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2150             COALESCE(biblioitems.ean,  deletedbiblioitems.ean)  AS ean,
2151             aqorders.basketno,
2152             aqbasket.basketname,
2153             aqbasket.basketgroupid,
2154             aqbasket.authorisedby,
2155             aqbasket.is_standing,
2156             concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2157             branch as managing_library,
2158             aqbasketgroups.name as groupname,
2159             aqbooksellers.name,
2160             aqbasket.creationdate,
2161             aqorders.datereceived,
2162             aqorders.quantity,
2163             aqorders.quantityreceived,
2164             aqorders.ecost,
2165             aqorders.ordernumber,
2166             aqorders.invoiceid,
2167             aqinvoices.invoicenumber,
2168             aqbooksellers.id as id,
2169             aqorders.biblionumber,
2170             aqorders.orderstatus,
2171             aqorders.parent_ordernumber,
2172             aqorders.order_internalnote,
2173             aqorders.order_vendornote,
2174             aqbudgets.budget_name
2175             ";
2176     $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2177     $query .= "
2178         FROM aqorders
2179         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2180         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2181         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2182         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2183         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2184         LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2185         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2186         LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2187         LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2188         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2189         ";
2190
2191     $query .= " WHERE 1 ";
2192
2193     unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2194         $query .= " AND datecancellationprinted IS NULL ";
2195     }
2196
2197     my @query_params  = ();
2198
2199     if ( $biblionumber ) {
2200         $query .= " AND biblio.biblionumber = ?";
2201         push @query_params, $biblionumber;
2202     }
2203
2204     if ( $title ) {
2205         $query .= " AND biblio.title LIKE ? ";
2206         $title =~ s/\s+/%/g;
2207         push @query_params, "%$title%";
2208     }
2209
2210     if ( $author ) {
2211         $query .= " AND biblio.author LIKE ? ";
2212         push @query_params, "%$author%";
2213     }
2214
2215     if ( @isbns ) {
2216         $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2217         foreach my $isb (@isbns){
2218             push @query_params, "%$isb%";
2219         }
2220     }
2221
2222     if ( @issns ) {
2223         $query .= " AND ( biblioitems.issn LIKE " . join (" OR biblioitems.issn LIKE ", @issn_params ) . ")";
2224         foreach my $isn (@issns){
2225             push @query_params, "%$isn%";
2226         }
2227     }
2228
2229     if ( $ean ) {
2230         $query .= " AND biblioitems.ean = ? ";
2231         push @query_params, "$ean";
2232     }
2233     if ( $name ) {
2234         $query .= " AND aqbooksellers.name LIKE ? ";
2235         push @query_params, "%$name%";
2236     }
2237
2238     if ( $budget ) {
2239         $query .= " AND aqbudgets.budget_id = ? ";
2240         push @query_params, "$budget";
2241     }
2242
2243     if ( $from_placed_on ) {
2244         $query .= " AND creationdate >= ? ";
2245         push @query_params, $from_placed_on;
2246     }
2247
2248     if ( $to_placed_on ) {
2249         $query .= " AND creationdate <= ? ";
2250         push @query_params, $to_placed_on;
2251     }
2252
2253     if ( defined $orderstatus and $orderstatus ne '') {
2254         $query .= " AND aqorders.orderstatus = ? ";
2255         push @query_params, "$orderstatus";
2256     }
2257
2258     if ( $is_standing ) {
2259         $query .= " AND is_standing = ? ";
2260         push @query_params, $is_standing;
2261     }
2262
2263     if ($basket) {
2264         if ($basket =~ m/^\d+$/) {
2265             $query .= " AND aqorders.basketno = ? ";
2266             push @query_params, $basket;
2267         } else {
2268             $query .= " AND aqbasket.basketname LIKE ? ";
2269             push @query_params, "%$basket%";
2270         }
2271     }
2272
2273     if ( $internalnote ) {
2274         $query .= " AND aqorders.order_internalnote LIKE ? ";
2275         push @query_params, "%$internalnote%";
2276     }
2277
2278     if ( $vendornote ) {
2279         $query .= " AND aqorders.order_vendornote LIKE ?";
2280         push @query_params, "%$vendornote%";
2281     }
2282
2283     if ($booksellerinvoicenumber) {
2284         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2285         push @query_params, "%$booksellerinvoicenumber%";
2286     }
2287
2288     if ($basketgroupname) {
2289         $query .= " AND aqbasketgroups.name LIKE ? ";
2290         push @query_params, "%$basketgroupname%";
2291     }
2292
2293     if ($ordernumber) {
2294         $query .= " AND (aqorders.ordernumber = ? ";
2295         push @query_params, $ordernumber;
2296         if ($search_children_too) {
2297             $query .= " OR aqorders.parent_ordernumber = ? ";
2298             push @query_params, $ordernumber;
2299         }
2300         $query .= ") ";
2301     }
2302
2303     if ( @$created_by ) {
2304         $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2305         push @query_params, @$created_by;
2306     }
2307
2308     if ( $managing_library ) {
2309         $query .= " AND aqbasket.branch = ? ";
2310         push @query_params, $managing_library;
2311     }
2312
2313     if ( @$ordernumbers ) {
2314         $query .= ' AND (aqorders.ordernumber IN ( ' . join (',', ('?') x @$ordernumbers ) . '))';
2315         push @query_params, @$ordernumbers;
2316     }
2317     if ( @$additional_fields ) {
2318         my @baskets = Koha::Acquisition::Baskets->filter_by_additional_fields($additional_fields)->as_list;
2319
2320         return [] unless @baskets;
2321
2322         # No parameterization because record IDs come directly from DB
2323         $query .= ' AND aqbasket.basketno IN ( ' . join( ',', map { $_->basketno } @baskets ) . ' )';
2324     }
2325
2326     if ( C4::Context->preference("IndependentBranches") ) {
2327         unless ( C4::Context->IsSuperLibrarian() ) {
2328             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2329             push @query_params, C4::Context->userenv->{branch};
2330         }
2331     }
2332     $query .= " ORDER BY id";
2333
2334     return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2335 }
2336
2337 =head2 GetRecentAcqui
2338
2339   $results = GetRecentAcqui($days);
2340
2341 C<$results> is a ref to a table which contains hashref
2342
2343 =cut
2344
2345 sub GetRecentAcqui {
2346     my $limit  = shift;
2347     my $dbh    = C4::Context->dbh;
2348     my $query = "
2349         SELECT *
2350         FROM   biblio
2351         ORDER BY timestamp DESC
2352         LIMIT  0,".$limit;
2353
2354     my $sth = $dbh->prepare($query);
2355     $sth->execute;
2356     my $results = $sth->fetchall_arrayref({});
2357     return $results;
2358 }
2359
2360 #------------------------------------------------------------#
2361
2362 =head3 AddClaim
2363
2364   &AddClaim($ordernumber);
2365
2366 Add a claim for an order
2367
2368 =cut
2369
2370 sub AddClaim {
2371     my ($ordernumber) = @_;
2372     my $dbh          = C4::Context->dbh;
2373     my $query        = "
2374         UPDATE aqorders SET
2375             claims_count = claims_count + 1,
2376             claimed_date = CURDATE()
2377         WHERE ordernumber = ?
2378         ";
2379     my $sth = $dbh->prepare($query);
2380     $sth->execute($ordernumber);
2381 }
2382
2383 =head3 GetInvoices
2384
2385     my @invoices = GetInvoices(
2386         invoicenumber => $invoicenumber,
2387         supplierid => $supplierid,
2388         suppliername => $suppliername,
2389         shipmentdatefrom => $shipmentdatefrom, # ISO format
2390         shipmentdateto => $shipmentdateto, # ISO format
2391         billingdatefrom => $billingdatefrom, # ISO format
2392         billingdateto => $billingdateto, # ISO format
2393         isbneanissn => $isbn_or_ean_or_issn,
2394         title => $title,
2395         author => $author,
2396         publisher => $publisher,
2397         publicationyear => $publicationyear,
2398         branchcode => $branchcode,
2399         order_by => $order_by
2400     );
2401
2402 Return a list of invoices that match all given criteria.
2403
2404 $order_by is "column_name (asc|desc)", where column_name is any of
2405 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2406 'shipmentcost', 'shipmentcost_budgetid'.
2407
2408 asc is the default if omitted
2409
2410 =cut
2411
2412 sub GetInvoices {
2413     my %args = @_;
2414
2415     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2416         closedate shipmentcost shipmentcost_budgetid);
2417
2418     my $dbh = C4::Context->dbh;
2419     my $query = qq{
2420         SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
2421             aqbooksellers.name AS suppliername,
2422           COUNT(
2423             DISTINCT IF(
2424               aqorders.datereceived IS NOT NULL,
2425               aqorders.biblionumber,
2426               NULL
2427             )
2428           ) AS receivedbiblios,
2429           COUNT(
2430              DISTINCT IF(
2431               aqorders.subscriptionid IS NOT NULL,
2432               aqorders.subscriptionid,
2433               NULL
2434             )
2435           ) AS is_linked_to_subscriptions,
2436           SUM(aqorders.quantityreceived) AS receiveditems
2437         FROM aqinvoices
2438           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2439           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2440           LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2441           LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2442           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2443           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2444           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2445     };
2446
2447     my @bind_args;
2448     my @bind_strs;
2449     if($args{supplierid}) {
2450         push @bind_strs, " aqinvoices.booksellerid = ? ";
2451         push @bind_args, $args{supplierid};
2452     }
2453     if($args{invoicenumber}) {
2454         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2455         push @bind_args, "%$args{invoicenumber}%";
2456     }
2457     if($args{suppliername}) {
2458         push @bind_strs, " aqbooksellers.name LIKE ? ";
2459         push @bind_args, "%$args{suppliername}%";
2460     }
2461     if($args{shipmentdatefrom}) {
2462         push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2463         push @bind_args, $args{shipmentdatefrom};
2464     }
2465     if($args{shipmentdateto}) {
2466         push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2467         push @bind_args, $args{shipmentdateto};
2468     }
2469     if($args{billingdatefrom}) {
2470         push @bind_strs, " aqinvoices.billingdate >= ? ";
2471         push @bind_args, $args{billingdatefrom};
2472     }
2473     if($args{billingdateto}) {
2474         push @bind_strs, " aqinvoices.billingdate <= ? ";
2475         push @bind_args, $args{billingdateto};
2476     }
2477     if($args{isbneanissn}) {
2478         push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2479         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2480     }
2481     if($args{title}) {
2482         push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2483         push @bind_args, $args{title};
2484     }
2485     if($args{author}) {
2486         push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2487         push @bind_args, $args{author};
2488     }
2489     if($args{publisher}) {
2490         push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2491         push @bind_args, $args{publisher};
2492     }
2493     if($args{publicationyear}) {
2494         push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2495         push @bind_args, $args{publicationyear}, $args{publicationyear};
2496     }
2497     if($args{branchcode}) {
2498         push @bind_strs, " borrowers.branchcode = ? ";
2499         push @bind_args, $args{branchcode};
2500     }
2501     if($args{message_id}) {
2502         push @bind_strs, " aqinvoices.message_id = ? ";
2503         push @bind_args, $args{message_id};
2504     }
2505
2506     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2507     $query .= " GROUP BY aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id, aqbooksellers.name";
2508
2509     if($args{order_by}) {
2510         my ($column, $direction) = split / /, $args{order_by};
2511         if(grep  { $_ eq $column } @columns) {
2512             $direction ||= 'ASC';
2513             $query .= " ORDER BY $column $direction";
2514         }
2515     }
2516
2517     my $sth = $dbh->prepare($query);
2518     $sth->execute(@bind_args);
2519
2520     my $results = $sth->fetchall_arrayref({});
2521     return @$results;
2522 }
2523
2524 =head3 GetInvoice
2525
2526     my $invoice = GetInvoice($invoiceid);
2527
2528 Get informations about invoice with given $invoiceid
2529
2530 Return a hash filled with aqinvoices.* fields
2531
2532 =cut
2533
2534 sub GetInvoice {
2535     my ($invoiceid) = @_;
2536     my $invoice;
2537
2538     return unless $invoiceid;
2539
2540     my $dbh = C4::Context->dbh;
2541     my $query = qq{
2542         SELECT *
2543         FROM aqinvoices
2544         WHERE invoiceid = ?
2545     };
2546     my $sth = $dbh->prepare($query);
2547     $sth->execute($invoiceid);
2548
2549     $invoice = $sth->fetchrow_hashref;
2550     return $invoice;
2551 }
2552
2553 =head3 GetInvoiceDetails
2554
2555     my $invoice = GetInvoiceDetails($invoiceid)
2556
2557 Return informations about an invoice + the list of related order lines
2558
2559 Orders informations are in $invoice->{orders} (array ref)
2560
2561 =cut
2562
2563 sub GetInvoiceDetails {
2564     my ($invoiceid) = @_;
2565
2566     if ( !defined $invoiceid ) {
2567         carp 'GetInvoiceDetails called without an invoiceid';
2568         return;
2569     }
2570
2571     my $dbh = C4::Context->dbh;
2572     my $query = q{
2573         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2574         FROM aqinvoices
2575           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2576         WHERE invoiceid = ?
2577     };
2578     my $sth = $dbh->prepare($query);
2579     $sth->execute($invoiceid);
2580
2581     my $invoice = $sth->fetchrow_hashref;
2582
2583     $query = q{
2584         SELECT aqorders.*,
2585                 biblio.*,
2586                 biblio.copyrightdate,
2587                 biblioitems.isbn,
2588                 biblioitems.publishercode,
2589                 biblioitems.publicationyear,
2590                 aqbasket.basketname,
2591                 aqbasketgroups.id AS basketgroupid,
2592                 aqbasketgroups.name AS basketgroupname
2593         FROM aqorders
2594           LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2595           LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2596           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2597           LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2598         WHERE invoiceid = ?
2599     };
2600     $sth = $dbh->prepare($query);
2601     $sth->execute($invoiceid);
2602     $invoice->{orders} = $sth->fetchall_arrayref({});
2603     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2604
2605     return $invoice;
2606 }
2607
2608 =head3 AddInvoice
2609
2610     my $invoiceid = AddInvoice(
2611         invoicenumber => $invoicenumber,
2612         booksellerid => $booksellerid,
2613         shipmentdate => $shipmentdate,
2614         billingdate => $billingdate,
2615         closedate => $closedate,
2616         shipmentcost => $shipmentcost,
2617         shipmentcost_budgetid => $shipmentcost_budgetid
2618     );
2619
2620 Create a new invoice and return its id or undef if it fails.
2621
2622 =cut
2623
2624 sub AddInvoice {
2625     my %invoice = @_;
2626
2627     return unless(%invoice and $invoice{invoicenumber});
2628
2629     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2630         closedate shipmentcost shipmentcost_budgetid message_id);
2631
2632     my @set_strs;
2633     my @set_args;
2634     foreach my $key (keys %invoice) {
2635         if(0 < grep { $_ eq $key } @columns) {
2636             push @set_strs, "$key = ?";
2637             push @set_args, ($invoice{$key} || undef);
2638         }
2639     }
2640
2641     my $rv;
2642     if(@set_args > 0) {
2643         my $dbh = C4::Context->dbh;
2644         my $query = "INSERT INTO aqinvoices SET ";
2645         $query .= join (",", @set_strs);
2646         my $sth = $dbh->prepare($query);
2647         $rv = $sth->execute(@set_args);
2648         if($rv) {
2649             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2650         }
2651     }
2652     return $rv;
2653 }
2654
2655 =head3 ModInvoice
2656
2657     ModInvoice(
2658         invoiceid => $invoiceid,    # Mandatory
2659         invoicenumber => $invoicenumber,
2660         booksellerid => $booksellerid,
2661         shipmentdate => $shipmentdate,
2662         billingdate => $billingdate,
2663         closedate => $closedate,
2664         shipmentcost => $shipmentcost,
2665         shipmentcost_budgetid => $shipmentcost_budgetid
2666     );
2667
2668 Modify an invoice, invoiceid is mandatory.
2669
2670 Return undef if it fails.
2671
2672 =cut
2673
2674 sub ModInvoice {
2675     my %invoice = @_;
2676
2677     return unless(%invoice and $invoice{invoiceid});
2678
2679     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2680         closedate shipmentcost shipmentcost_budgetid);
2681
2682     my @set_strs;
2683     my @set_args;
2684     foreach my $key (keys %invoice) {
2685         if(0 < grep { $_ eq $key } @columns) {
2686             push @set_strs, "$key = ?";
2687             push @set_args, ($invoice{$key} || undef);
2688         }
2689     }
2690
2691     my $dbh = C4::Context->dbh;
2692     my $query = "UPDATE aqinvoices SET ";
2693     $query .= join(",", @set_strs);
2694     $query .= " WHERE invoiceid = ?";
2695
2696     my $sth = $dbh->prepare($query);
2697     $sth->execute(@set_args, $invoice{invoiceid});
2698 }
2699
2700 =head3 CloseInvoice
2701
2702     CloseInvoice($invoiceid);
2703
2704 Close an invoice.
2705
2706 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2707
2708 =cut
2709
2710 sub CloseInvoice {
2711     my ($invoiceid) = @_;
2712
2713     return unless $invoiceid;
2714
2715     my $dbh = C4::Context->dbh;
2716     my $query = qq{
2717         UPDATE aqinvoices
2718         SET closedate = CAST(NOW() AS DATE)
2719         WHERE invoiceid = ?
2720     };
2721     my $sth = $dbh->prepare($query);
2722     $sth->execute($invoiceid);
2723 }
2724
2725 =head3 ReopenInvoice
2726
2727     ReopenInvoice($invoiceid);
2728
2729 Reopen an invoice
2730
2731 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => $closedate );
2732
2733 =cut
2734
2735 sub ReopenInvoice {
2736     my ($invoiceid) = @_;
2737
2738     return unless $invoiceid;
2739
2740     my $dbh = C4::Context->dbh;
2741     my $query = qq{
2742         UPDATE aqinvoices
2743         SET closedate = NULL
2744         WHERE invoiceid = ?
2745     };
2746     my $sth = $dbh->prepare($query);
2747     $sth->execute($invoiceid);
2748 }
2749
2750 =head3 DelInvoice
2751
2752     DelInvoice($invoiceid);
2753
2754 Delete an invoice if there are no items attached to it.
2755
2756 =cut
2757
2758 sub DelInvoice {
2759     my ($invoiceid) = @_;
2760
2761     return unless $invoiceid;
2762
2763     my $dbh   = C4::Context->dbh;
2764     my $query = qq{
2765         SELECT COUNT(*)
2766         FROM aqorders
2767         WHERE invoiceid = ?
2768     };
2769     my $sth = $dbh->prepare($query);
2770     $sth->execute($invoiceid);
2771     my $res = $sth->fetchrow_arrayref;
2772     if ( $res && $res->[0] == 0 ) {
2773         $query = qq{
2774             DELETE FROM aqinvoices
2775             WHERE invoiceid = ?
2776         };
2777         my $sth = $dbh->prepare($query);
2778         return ( $sth->execute($invoiceid) > 0 );
2779     }
2780     return;
2781 }
2782
2783 =head3 MergeInvoices
2784
2785     MergeInvoices($invoiceid, \@sourceids);
2786
2787 Merge the invoices identified by the IDs in \@sourceids into
2788 the invoice identified by $invoiceid.
2789
2790 =cut
2791
2792 sub MergeInvoices {
2793     my ($invoiceid, $sourceids) = @_;
2794
2795     return unless $invoiceid;
2796     foreach my $sourceid (@$sourceids) {
2797         next if $sourceid == $invoiceid;
2798         my $source = GetInvoiceDetails($sourceid);
2799         foreach my $order (@{$source->{'orders'}}) {
2800             $order->{'invoiceid'} = $invoiceid;
2801             ModOrder($order);
2802         }
2803         DelInvoice($source->{'invoiceid'});
2804     }
2805     return;
2806 }
2807
2808 =head3 GetBiblioCountByBasketno
2809
2810 $biblio_count = &GetBiblioCountByBasketno($basketno);
2811
2812 Looks up the biblio's count that has basketno value $basketno
2813
2814 Returns a quantity
2815
2816 =cut
2817
2818 sub GetBiblioCountByBasketno {
2819     my ($basketno) = @_;
2820     my $dbh          = C4::Context->dbh;
2821     my $query        = "
2822         SELECT COUNT( DISTINCT( biblionumber ) )
2823         FROM   aqorders
2824         WHERE  basketno = ?
2825             AND datecancellationprinted IS NULL
2826         ";
2827
2828     my $sth = $dbh->prepare($query);
2829     $sth->execute($basketno);
2830     return $sth->fetchrow;
2831 }
2832
2833 =head3 GetOrderUsers
2834
2835     $order_users_ids = &GetOrderUsers($ordernumber);
2836
2837 Returns a list of all borrowernumbers that are in order users list
2838
2839 =cut
2840
2841 sub GetOrderUsers {
2842     my ($ordernumber) = @_;
2843
2844     return unless $ordernumber;
2845
2846     my $query = q|
2847         SELECT borrowernumber
2848         FROM aqorder_users
2849         WHERE ordernumber = ?
2850     |;
2851     my $dbh = C4::Context->dbh;
2852     my $sth = $dbh->prepare($query);
2853     $sth->execute($ordernumber);
2854     my $results = $sth->fetchall_arrayref( {} );
2855
2856     my @borrowernumbers;
2857     foreach (@$results) {
2858         push @borrowernumbers, $_->{'borrowernumber'};
2859     }
2860
2861     return @borrowernumbers;
2862 }
2863
2864 =head3 ModOrderUsers
2865
2866     my @order_users_ids = (1, 2, 3);
2867     &ModOrderUsers($ordernumber, @basketusers_ids);
2868
2869 Delete all users from order users list, and add users in C<@order_users_ids>
2870 to this users list.
2871
2872 =cut
2873
2874 sub ModOrderUsers {
2875     my ( $ordernumber, @order_users_ids ) = @_;
2876
2877     return unless $ordernumber;
2878
2879     my $dbh   = C4::Context->dbh;
2880     my $query = q|
2881         DELETE FROM aqorder_users
2882         WHERE ordernumber = ?
2883     |;
2884     my $sth = $dbh->prepare($query);
2885     $sth->execute($ordernumber);
2886
2887     $query = q|
2888         INSERT INTO aqorder_users (ordernumber, borrowernumber)
2889         VALUES (?, ?)
2890     |;
2891     $sth = $dbh->prepare($query);
2892     foreach my $order_user_id (@order_users_ids) {
2893         $sth->execute( $ordernumber, $order_user_id );
2894     }
2895 }
2896
2897 sub NotifyOrderUsers {
2898     my ($ordernumber) = @_;
2899
2900     my @borrowernumbers = GetOrderUsers($ordernumber);
2901     return unless @borrowernumbers;
2902
2903     my $order = GetOrder( $ordernumber );
2904     for my $borrowernumber (@borrowernumbers) {
2905         my $patron = Koha::Patrons->find( $borrowernumber );
2906         my $library = $patron->library->unblessed;
2907         my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed;
2908         my $letter = C4::Letters::GetPreparedLetter(
2909             module      => 'acquisition',
2910             letter_code => 'ACQ_NOTIF_ON_RECEIV',
2911             branchcode  => $library->{branchcode},
2912             lang        => $patron->lang,
2913             tables      => {
2914                 'branches'    => $library,
2915                 'borrowers'   => $patron->unblessed,
2916                 'biblio'      => $biblio,
2917                 'aqorders'    => $order,
2918             },
2919         );
2920         if ( $letter ) {
2921             C4::Letters::EnqueueLetter(
2922                 {
2923                     letter         => $letter,
2924                     borrowernumber => $borrowernumber,
2925                     LibraryName    => C4::Context->preference("LibraryName"),
2926                     message_transport_type => 'email',
2927                 }
2928             ) or warn "can't enqueue letter $letter";
2929         }
2930     }
2931 }
2932
2933 =head3 FillWithDefaultValues
2934
2935 FillWithDefaultValues( $marc_record, $params );
2936
2937 This will update the record with default value defined in the ACQ framework.
2938 For all existing fields, if a default value exists and there are no subfield, it will be created.
2939 If the field does not exist, it will be created too.
2940
2941 If the parameter only_mandatory => 1 is passed via $params, only the mandatory
2942 defaults are being applied to the record.
2943
2944 =cut
2945
2946 sub FillWithDefaultValues {
2947     my ( $record, $params ) = @_;
2948     my $mandatory = $params->{only_mandatory};
2949     my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
2950     if ($tagslib) {
2951         my ($itemfield) =
2952           C4::Biblio::GetMarcFromKohaField( 'items.itemnumber' );
2953         for my $tag ( sort keys %$tagslib ) {
2954             next unless $tag;
2955             next if $tag == $itemfield;
2956             for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
2957                 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
2958                 next if $mandatory && !$tagslib->{$tag}{$subfield}{mandatory};
2959                 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
2960                 if ( defined $defaultvalue and $defaultvalue ne '' ) {
2961                     my @fields = $record->field($tag);
2962                     if (@fields) {
2963                         for my $field (@fields) {
2964                             if ( $field->is_control_field ) {
2965                                 $field->update($defaultvalue) if not defined $field->data;
2966                             }
2967                             elsif ( not defined $field->subfield($subfield) ) {
2968                                 $field->add_subfields(
2969                                     $subfield => $defaultvalue );
2970                             }
2971                         }
2972                     }
2973                     else {
2974                         if ( $tag < 10 ) { # is_control_field
2975                             $record->insert_fields_ordered(
2976                                 MARC::Field->new(
2977                                     $tag, $defaultvalue
2978                                 )
2979                             );
2980                         }
2981                         else {
2982                             $record->insert_fields_ordered(
2983                                 MARC::Field->new(
2984                                     $tag, '', '', $subfield => $defaultvalue
2985                                 )
2986                             );
2987                         }
2988                     }
2989                 }
2990             }
2991         }
2992     }
2993 }
2994
2995 1;
2996 __END__
2997
2998 =head1 AUTHOR
2999
3000 Koha Development Team <http://koha-community.org/>
3001
3002 =cut