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