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