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_vendornote'},
 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_vendornote},
 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 = q{
 636         SELECT aqbasket.*,
 637           SUM(aqorders.quantity) AS total_items,
 638           SUM(
 639             IF ( aqorders.orderstatus = 'cancelled', aqorders.quantity, 0 )
 640           ) AS total_items_cancelled,
 641           COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
 642           SUM(
 643             IF(aqorders.datereceived IS NULL
 644               AND aqorders.datecancellationprinted IS NULL
 645             , aqorders.quantity
 646             , 0)
 647           ) AS expected_items
 648         FROM aqbasket
 649           LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
 650         WHERE booksellerid = ?};
 651
 652     unless ( $allbaskets ) {
 653         $query.=" AND (closedate IS NULL OR (aqorders.quantity > aqorders.quantityreceived AND datecancellationprinted IS NULL))";
 654     }
 655     $query.=" GROUP BY aqbasket.basketno";
 656
 657     my $sth = $dbh->prepare($query);
 658     $sth->execute($supplierid);
 659     my $baskets = $sth->fetchall_arrayref({});
 660
 661     # Retrieve the number of biblios cancelled
 662     my $cancelled_biblios = $dbh->selectall_hashref( q|
 663         SELECT COUNT(DISTINCT(biblionumber)) AS total_biblios_cancelled, aqbasket.basketno
 664         FROM aqbasket
 665         LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
 666         WHERE booksellerid = ?
 667         AND aqorders.orderstatus = 'cancelled'
 668         GROUP BY aqbasket.basketno
 669     |, 'basketno', {}, $supplierid );
 670     map {
 671         $_->{total_biblios_cancelled} = $cancelled_biblios->{$_->{basketno}}{total_biblios_cancelled} || 0
 672     } @$baskets;
 673
 674     return $baskets;
 675 }
 676
 677 =head3 GetBasketUsers
 678
 679     $basketusers_ids = &GetBasketUsers($basketno);
 680
 681 Returns a list of all borrowernumbers that are in basket users list
 682
 683 =cut
 684
 685 sub GetBasketUsers {
 686     my $basketno = shift;
 687
 688     return unless $basketno;
 689
 690     my $query = qq{
 691         SELECT borrowernumber
 692         FROM aqbasketusers
 693         WHERE basketno = ?
 694     };
 695     my $dbh = C4::Context->dbh;
 696     my $sth = $dbh->prepare($query);
 697     $sth->execute($basketno);
 698     my $results = $sth->fetchall_arrayref( {} );
 699
 700     my @borrowernumbers;
 701     foreach (@$results) {
 702         push @borrowernumbers, $_->{'borrowernumber'};
 703     }
 704
 705     return @borrowernumbers;
 706 }
 707
 708 =head3 ModBasketUsers
 709
 710     my @basketusers_ids = (1, 2, 3);
 711     &ModBasketUsers($basketno, @basketusers_ids);
 712
 713 Delete all users from basket users list, and add users in C<@basketusers_ids>
 714 to this users list.
 715
 716 =cut
 717
 718 sub ModBasketUsers {
 719     my ($basketno, @basketusers_ids) = @_;
 720
 721     return unless $basketno;
 722
 723     my $dbh = C4::Context->dbh;
 724     my $query = qq{
 725         DELETE FROM aqbasketusers
 726         WHERE basketno = ?
 727     };
 728     my $sth = $dbh->prepare($query);
 729     $sth->execute($basketno);
 730
 731     $query = qq{
 732         INSERT INTO aqbasketusers (basketno, borrowernumber)
 733         VALUES (?, ?)
 734     };
 735     $sth = $dbh->prepare($query);
 736     foreach my $basketuser_id (@basketusers_ids) {
 737         $sth->execute($basketno, $basketuser_id);
 738     }
 739     return;
 740 }
 741
 742 =head3 CanUserManageBasket
 743
 744     my $bool = CanUserManageBasket($borrower, $basket[, $userflags]);
 745     my $bool = CanUserManageBasket($borrowernumber, $basketno[, $userflags]);
 746
 747 Check if a borrower can manage a basket, according to system preference
 748 AcqViewBaskets, user permissions and basket properties (creator, users list,
 749 branch).
 750
 751 First parameter can be either a borrowernumber or a hashref as returned by
 752 C4::Members::GetMember.
 753
 754 Second parameter can be either a basketno or a hashref as returned by
 755 C4::Acquisition::GetBasket.
 756
 757 The third parameter is optional. If given, it should be a hashref as returned
 758 by C4::Auth::getuserflags. If not, getuserflags is called.
 759
 760 If user is authorised to manage basket, returns 1.
 761 Otherwise returns 0.
 762
 763 =cut
 764
 765 sub CanUserManageBasket {
 766     my ($borrower, $basket, $userflags) = @_;
 767
 768     if (!ref $borrower) {
 769         $borrower = C4::Members::GetMember(borrowernumber => $borrower);
 770     }
 771     if (!ref $basket) {
 772         $basket = GetBasket($basket);
 773     }
 774
 775     return 0 unless ($basket and $borrower);
 776
 777     my $borrowernumber = $borrower->{borrowernumber};
 778     my $basketno = $basket->{basketno};
 779
 780     my $AcqViewBaskets = C4::Context->preference('AcqViewBaskets');
 781
 782     if (!defined $userflags) {
 783         my $dbh = C4::Context->dbh;
 784         my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE borrowernumber = ?");
 785         $sth->execute($borrowernumber);
 786         my ($flags) = $sth->fetchrow_array;
 787         $sth->finish;
 788
 789         $userflags = C4::Auth::getuserflags($flags, $borrower->{userid}, $dbh);
 790     }
 791
 792     unless ($userflags->{superlibrarian}
 793     || (ref $userflags->{acquisition} && $userflags->{acquisition}->{order_manage_all})
 794     || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
 795     {
 796         if (not exists $userflags->{acquisition}) {
 797             return 0;
 798         }
 799
 800         if ( (ref $userflags->{acquisition} && !$userflags->{acquisition}->{order_manage})
 801         || (!ref $userflags->{acquisition} && !$userflags->{acquisition}) ) {
 802             return 0;
 803         }
 804
 805         if ($AcqViewBaskets eq 'user'
 806         && $basket->{authorisedby} != $borrowernumber
 807         && grep($borrowernumber, GetBasketUsers($basketno)) == 0) {
 808             return 0;
 809         }
 810
 811         if ($AcqViewBaskets eq 'branch' && defined $basket->{branch}
 812         && $basket->{branch} ne $borrower->{branchcode}) {
 813             return 0;
 814         }
 815     }
 816
 817     return 1;
 818 }
 819
 820 #------------------------------------------------------------#
 821
 822 =head3 GetBasketsByBasketgroup
 823
 824   $baskets = &GetBasketsByBasketgroup($basketgroupid);
 825
 826 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
 827
 828 =cut
 829
 830 sub GetBasketsByBasketgroup {
 831     my $basketgroupid = shift;
 832     my $query = qq{
 833         SELECT *, aqbasket.booksellerid as booksellerid
 834         FROM aqbasket
 835         LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?
 836     };
 837     my $dbh = C4::Context->dbh;
 838     my $sth = $dbh->prepare($query);
 839     $sth->execute($basketgroupid);
 840     return $sth->fetchall_arrayref({});
 841 }
 842
 843 #------------------------------------------------------------#
 844
 845 =head3 NewBasketgroup
 846
 847   $basketgroupid = NewBasketgroup(\%hashref);
 848
 849 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
 850
 851 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
 852
 853 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 854
 855 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 856
 857 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
 858
 859 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
 860
 861 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
 862
 863 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
 864
 865 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 866
 867 =cut
 868
 869 sub NewBasketgroup {
 870     my $basketgroupinfo = shift;
 871     die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
 872     my $query = "INSERT INTO aqbasketgroups (";
 873     my @params;
 874     foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
 875         if ( defined $basketgroupinfo->{$field} ) {
 876             $query .= "$field, ";
 877             push(@params, $basketgroupinfo->{$field});
 878         }
 879     }
 880     $query .= "booksellerid) VALUES (";
 881     foreach (@params) {
 882         $query .= "?, ";
 883     }
 884     $query .= "?)";
 885     push(@params, $basketgroupinfo->{'booksellerid'});
 886     my $dbh = C4::Context->dbh;
 887     my $sth = $dbh->prepare($query);
 888     $sth->execute(@params);
 889     my $basketgroupid = $dbh->{'mysql_insertid'};
 890     if( $basketgroupinfo->{'basketlist'} ) {
 891         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
 892             my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
 893             my $sth2 = $dbh->prepare($query2);
 894             $sth2->execute($basketgroupid, $basketno);
 895         }
 896     }
 897     return $basketgroupid;
 898 }
 899
 900 #------------------------------------------------------------#
 901
 902 =head3 ModBasketgroup
 903
 904   ModBasketgroup(\%hashref);
 905
 906 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
 907
 908 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
 909
 910 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 911
 912 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 913
 914 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
 915
 916 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
 917
 918 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
 919
 920 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
 921
 922 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 923
 924 =cut
 925
 926 sub ModBasketgroup {
 927     my $basketgroupinfo = shift;
 928     die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
 929     my $dbh = C4::Context->dbh;
 930     my $query = "UPDATE aqbasketgroups SET ";
 931     my @params;
 932     foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
 933         if ( defined $basketgroupinfo->{$field} ) {
 934             $query .= "$field=?, ";
 935             push(@params, $basketgroupinfo->{$field});
 936         }
 937     }
 938     chop($query);
 939     chop($query);
 940     $query .= " WHERE id=?";
 941     push(@params, $basketgroupinfo->{'id'});
 942     my $sth = $dbh->prepare($query);
 943     $sth->execute(@params);
 944
 945     $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
 946     $sth->execute($basketgroupinfo->{'id'});
 947
 948     if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
 949         $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
 950         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
 951             $sth->execute($basketgroupinfo->{'id'}, $basketno);
 952         }
 953     }
 954     return;
 955 }
 956
 957 #------------------------------------------------------------#
 958
 959 =head3 DelBasketgroup
 960
 961   DelBasketgroup($basketgroupid);
 962
 963 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
 964
 965 =over
 966
 967 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
 968
 969 =back
 970
 971 =cut
 972
 973 sub DelBasketgroup {
 974     my $basketgroupid = shift;
 975     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
 976     my $query = "DELETE FROM aqbasketgroups WHERE id=?";
 977     my $dbh = C4::Context->dbh;
 978     my $sth = $dbh->prepare($query);
 979     $sth->execute($basketgroupid);
 980     return;
 981 }
 982
 983 #------------------------------------------------------------#
 984
 985
 986 =head2 FUNCTIONS ABOUT ORDERS
 987
 988 =head3 GetBasketgroup
 989
 990   $basketgroup = &GetBasketgroup($basketgroupid);
 991
 992 Returns a reference to the hash containing all information about the basketgroup.
 993
 994 =cut
 995
 996 sub GetBasketgroup {
 997     my $basketgroupid = shift;
 998     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
 999     my $dbh = C4::Context->dbh;
1000     my $result_set = $dbh->selectall_arrayref(
1001         'SELECT * FROM aqbasketgroups WHERE id=?',
1002         { Slice => {} },
1003         $basketgroupid
1004     );
1005     return $result_set->[0];    # id is unique
1006 }
1007
1008 #------------------------------------------------------------#
1009
1010 =head3 GetBasketgroups
1011
1012   $basketgroups = &GetBasketgroups($booksellerid);
1013
1014 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
1015
1016 =cut
1017
1018 sub GetBasketgroups {
1019     my $booksellerid = shift;
1020     die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
1021     my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
1022     my $dbh = C4::Context->dbh;
1023     my $sth = $dbh->prepare($query);
1024     $sth->execute($booksellerid);
1025     return $sth->fetchall_arrayref({});
1026 }
1027
1028 #------------------------------------------------------------#
1029
1030 =head2 FUNCTIONS ABOUT ORDERS
1031
1032 =head3 GetOrders
1033
1034   @orders = &GetOrders($basketnumber, $orderby);
1035
1036 Looks up the pending (non-cancelled) orders with the given basket
1037 number. If C<$booksellerID> is non-empty, only orders from that seller
1038 are returned.
1039
1040 return :
1041 C<&basket> returns a two-element array. C<@orders> is an array of
1042 references-to-hash, whose keys are the fields from the aqorders,
1043 biblio, and biblioitems tables in the Koha database.
1044
1045 =cut
1046
1047 sub GetOrders {
1048     my ( $basketno, $orderby ) = @_;
1049     return () unless $basketno;
1050     my $dbh   = C4::Context->dbh;
1051     my $query  ="
1052         SELECT biblio.*,biblioitems.*,
1053                 aqorders.*,
1054                 aqbudgets.*,
1055                 biblio.title,
1056                 aqorders_transfers.ordernumber_from AS transferred_from,
1057                 aqorders_transfers.timestamp AS transferred_from_timestamp
1058         FROM    aqorders
1059             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
1060             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
1061             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
1062             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1063         WHERE   basketno=?
1064             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
1065     ";
1066
1067     $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
1068     $query .= " ORDER BY $orderby";
1069     my $result_set =
1070       $dbh->selectall_arrayref( $query, { Slice => {} }, $basketno );
1071     return @{$result_set};
1072
1073 }
1074
1075 #------------------------------------------------------------#
1076 =head3 GetOrdersByBiblionumber
1077
1078   @orders = &GetOrdersByBiblionumber($biblionumber);
1079
1080 Looks up the orders with linked to a specific $biblionumber, including
1081 cancelled orders and received orders.
1082
1083 return :
1084 C<@orders> is an array of references-to-hash, whose keys are the
1085 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
1086
1087 =cut
1088
1089 sub GetOrdersByBiblionumber {
1090     my $biblionumber = shift;
1091     return unless $biblionumber;
1092     my $dbh   = C4::Context->dbh;
1093     my $query  ="
1094         SELECT biblio.*,biblioitems.*,
1095                 aqorders.*,
1096                 aqbudgets.*
1097         FROM    aqorders
1098             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
1099             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
1100             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
1101         WHERE   aqorders.biblionumber=?
1102     ";
1103     my $result_set =
1104       $dbh->selectall_arrayref( $query, { Slice => {} }, $biblionumber );
1105     return @{$result_set};
1106
1107 }
1108
1109 #------------------------------------------------------------#
1110
1111 =head3 GetOrder
1112
1113   $order = &GetOrder($ordernumber);
1114
1115 Looks up an order by order number.
1116
1117 Returns a reference-to-hash describing the order. The keys of
1118 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1119
1120 =cut
1121
1122 sub GetOrder {
1123     my ($ordernumber) = @_;
1124     return unless $ordernumber;
1125
1126     my $dbh      = C4::Context->dbh;
1127     my $query = qq{SELECT
1128                 aqorders.*,
1129                 biblio.title,
1130                 biblio.author,
1131                 aqbasket.basketname,
1132                 borrowers.branchcode,
1133                 biblioitems.publicationyear,
1134                 biblio.copyrightdate,
1135                 biblioitems.editionstatement,
1136                 biblioitems.isbn,
1137                 biblioitems.ean,
1138                 biblio.seriestitle,
1139                 biblioitems.publishercode,
1140                 aqorders.rrp              AS unitpricesupplier,
1141                 aqorders.ecost            AS unitpricelib,
1142                 aqorders.claims_count     AS claims_count,
1143                 aqorders.claimed_date     AS claimed_date,
1144                 aqbudgets.budget_name     AS budget,
1145                 aqbooksellers.name        AS supplier,
1146                 aqbooksellers.id          AS supplierid,
1147                 biblioitems.publishercode AS publisher,
1148                 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1149                 DATE(aqbasket.closedate)  AS orderdate,
1150                 aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity_to_receive,
1151                 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1152                 DATEDIFF(CURDATE( ),closedate) AS latesince
1153                 FROM aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1154                 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1155                 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1156                 aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby = borrowers.borrowernumber
1157                 LEFT JOIN aqbooksellers       ON aqbasket.booksellerid = aqbooksellers.id
1158                 WHERE aqorders.basketno = aqbasket.basketno
1159                     AND ordernumber=?};
1160     my $result_set =
1161       $dbh->selectall_arrayref( $query, { Slice => {} }, $ordernumber );
1162
1163     # result_set assumed to contain 1 match
1164     return $result_set->[0];
1165 }
1166
1167 =head3 GetLastOrderNotReceivedFromSubscriptionid
1168
1169   $order = &GetLastOrderNotReceivedFromSubscriptionid($subscriptionid);
1170
1171 Returns a reference-to-hash describing the last order not received for a subscription.
1172
1173 =cut
1174
1175 sub GetLastOrderNotReceivedFromSubscriptionid {
1176     my ( $subscriptionid ) = @_;
1177     my $dbh                = C4::Context->dbh;
1178     my $query              = qq|
1179         SELECT * FROM aqorders
1180         LEFT JOIN subscription
1181             ON ( aqorders.subscriptionid = subscription.subscriptionid )
1182         WHERE aqorders.subscriptionid = ?
1183             AND aqorders.datereceived IS NULL
1184         LIMIT 1
1185     |;
1186     my $result_set =
1187       $dbh->selectall_arrayref( $query, { Slice => {} }, $subscriptionid );
1188
1189     # result_set assumed to contain 1 match
1190     return $result_set->[0];
1191 }
1192
1193 =head3 GetLastOrderReceivedFromSubscriptionid
1194
1195   $order = &GetLastOrderReceivedFromSubscriptionid($subscriptionid);
1196
1197 Returns a reference-to-hash describing the last order received for a subscription.
1198
1199 =cut
1200
1201 sub GetLastOrderReceivedFromSubscriptionid {
1202     my ( $subscriptionid ) = @_;
1203     my $dbh                = C4::Context->dbh;
1204     my $query              = qq|
1205         SELECT * FROM aqorders
1206         LEFT JOIN subscription
1207             ON ( aqorders.subscriptionid = subscription.subscriptionid )
1208         WHERE aqorders.subscriptionid = ?
1209             AND aqorders.datereceived =
1210                 (
1211                     SELECT MAX( aqorders.datereceived )
1212                     FROM aqorders
1213                     LEFT JOIN subscription
1214                         ON ( aqorders.subscriptionid = subscription.subscriptionid )
1215                         WHERE aqorders.subscriptionid = ?
1216                             AND aqorders.datereceived IS NOT NULL
1217                 )
1218         ORDER BY ordernumber DESC
1219         LIMIT 1
1220     |;
1221     my $result_set =
1222       $dbh->selectall_arrayref( $query, { Slice => {} }, $subscriptionid, $subscriptionid );
1223
1224     # result_set assumed to contain 1 match
1225     return $result_set->[0];
1226
1227 }
1228
1229
1230 #------------------------------------------------------------#
1231
1232 =head3 NewOrder
1233
1234   &NewOrder(\%hashref);
1235
1236 Adds a new order to the database. Any argument that isn't described
1237 below is the new value of the field with the same name in the aqorders
1238 table of the Koha database.
1239
1240 =over
1241
1242 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
1243
1244 =item $hashref->{'ordernumber'} is a "minimum order number."
1245
1246 =item $hashref->{'budgetdate'} is effectively ignored.
1247 If it's undef (anything false) or the string 'now', the current day is used.
1248 Else, the upcoming July 1st is used.
1249
1250 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
1251
1252 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
1253
1254 =item defaults entrydate to Now
1255
1256 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".
1257
1258 =back
1259
1260 =cut
1261
1262 sub NewOrder {
1263     my $orderinfo = shift;
1264
1265     my $dbh = C4::Context->dbh;
1266     my @params;
1267
1268
1269     # if these parameters are missing, we can't continue
1270     for my $key (qw/basketno quantity biblionumber budget_id/) {
1271         croak "Mandatory parameter $key missing" unless $orderinfo->{$key};
1272     }
1273
1274     if ( defined $orderinfo->{subscription} && $orderinfo->{'subscription'} eq 'yes' ) {
1275         $orderinfo->{'subscription'} = 1;
1276     } else {
1277         $orderinfo->{'subscription'} = 0;
1278     }
1279     $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
1280     if (!$orderinfo->{quantityreceived}) {
1281         $orderinfo->{quantityreceived} = 0;
1282     }
1283
1284     my $ordernumber=InsertInTable("aqorders",$orderinfo);
1285     if (not $orderinfo->{parent_ordernumber}) {
1286         my $sth = $dbh->prepare("
1287             UPDATE aqorders
1288             SET parent_ordernumber = ordernumber
1289             WHERE ordernumber = ?
1290         ");
1291         $sth->execute($ordernumber);
1292     }
1293     return ( $orderinfo->{'basketno'}, $ordernumber );
1294 }
1295
1296
1297
1298 #------------------------------------------------------------#
1299
1300 =head3 NewOrderItem
1301
1302   &NewOrderItem();
1303
1304 =cut
1305
1306 sub NewOrderItem {
1307     my ($itemnumber, $ordernumber)  = @_;
1308     my $dbh = C4::Context->dbh;
1309     my $query = qq|
1310             INSERT INTO aqorders_items
1311                 (itemnumber, ordernumber)
1312             VALUES (?,?)    |;
1313
1314     my $sth = $dbh->prepare($query);
1315     $sth->execute( $itemnumber, $ordernumber);
1316 }
1317
1318 #------------------------------------------------------------#
1319
1320 =head3 ModOrder
1321
1322   &ModOrder(\%hashref);
1323
1324 Modifies an existing order. Updates the order with order number
1325 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1326 other keys of the hash update the fields with the same name in the aqorders
1327 table of the Koha database.
1328
1329 =cut
1330
1331 sub ModOrder {
1332     my $orderinfo = shift;
1333
1334     die "Ordernumber is required"     if $orderinfo->{'ordernumber'} eq  '' ;
1335     die "Biblionumber is required"  if  $orderinfo->{'biblionumber'} eq '';
1336
1337     my $dbh = C4::Context->dbh;
1338     my @params;
1339
1340     # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1341     $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1342
1343 #    delete($orderinfo->{'branchcode'});
1344     # the hash contains a lot of entries not in aqorders, so get the columns ...
1345     my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1346     $sth->execute;
1347     my $colnames = $sth->{NAME};
1348         #FIXME Be careful. If aqorders would have columns with diacritics,
1349         #you should need to decode what you get back from NAME.
1350         #See report 10110 and guided_reports.pl
1351     my $query = "UPDATE aqorders SET ";
1352
1353     foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1354         # ... and skip hash entries that are not in the aqorders table
1355         # FIXME : probably not the best way to do it (would be better to have a correct hash)
1356         next unless grep(/^$orderinfokey$/, @$colnames);
1357             $query .= "$orderinfokey=?, ";
1358             push(@params, $orderinfo->{$orderinfokey});
1359     }
1360
1361     $query .= "timestamp=NOW()  WHERE  ordernumber=?";
1362     push(@params, $orderinfo->{'ordernumber'} );
1363     $sth = $dbh->prepare($query);
1364     $sth->execute(@params);
1365     return;
1366 }
1367
1368 #------------------------------------------------------------#
1369
1370 =head3 ModItemOrder
1371
1372     ModItemOrder($itemnumber, $ordernumber);
1373
1374 Modifies the ordernumber of an item in aqorders_items.
1375
1376 =cut
1377
1378 sub ModItemOrder {
1379     my ($itemnumber, $ordernumber) = @_;
1380
1381     return unless ($itemnumber and $ordernumber);
1382
1383     my $dbh = C4::Context->dbh;
1384     my $query = qq{
1385         UPDATE aqorders_items
1386         SET ordernumber = ?
1387         WHERE itemnumber = ?
1388     };
1389     my $sth = $dbh->prepare($query);
1390     return $sth->execute($ordernumber, $itemnumber);
1391 }
1392
1393 #------------------------------------------------------------#
1394
1395 =head3 GetCancelledOrders
1396
1397   my @orders = GetCancelledOrders($basketno, $orderby);
1398
1399 Returns cancelled orders for a basket
1400
1401 =cut
1402
1403 sub GetCancelledOrders {
1404     my ( $basketno, $orderby ) = @_;
1405
1406     return () unless $basketno;
1407
1408     my $dbh   = C4::Context->dbh;
1409     my $query = "
1410         SELECT
1411             biblio.*,
1412             biblioitems.*,
1413             aqorders.*,
1414             aqbudgets.*,
1415             aqorders_transfers.ordernumber_to AS transferred_to,
1416             aqorders_transfers.timestamp AS transferred_to_timestamp
1417         FROM aqorders
1418           LEFT JOIN aqbudgets   ON aqbudgets.budget_id = aqorders.budget_id
1419           LEFT JOIN biblio      ON biblio.biblionumber = aqorders.biblionumber
1420           LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1421           LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
1422         WHERE basketno = ?
1423           AND (datecancellationprinted IS NOT NULL
1424                AND datecancellationprinted <> '0000-00-00')
1425     ";
1426
1427     $orderby = "aqorders.datecancellationprinted desc, aqorders.timestamp desc"
1428         unless $orderby;
1429     $query .= " ORDER BY $orderby";
1430     my $sth = $dbh->prepare($query);
1431     $sth->execute($basketno);
1432     my $results = $sth->fetchall_arrayref( {} );
1433
1434     return @$results;
1435 }
1436
1437
1438 #------------------------------------------------------------#
1439
1440 =head3 ModReceiveOrder
1441
1442   &ModReceiveOrder({
1443     biblionumber => $biblionumber,
1444     ordernumber => $ordernumber,
1445     quantityreceived => $quantityreceived,
1446     user => $user,
1447     cost => $cost,
1448     ecost => $ecost,
1449     invoiceid => $invoiceid,
1450     rrp => $rrp,
1451     budget_id => $budget_id,
1452     datereceived => $datereceived,
1453     received_itemnumbers => \@received_itemnumbers,
1454     order_internalnote => $order_internalnote,
1455     order_vendornote => $order_vendornote,
1456    });
1457
1458 Updates an order, to reflect the fact that it was received, at least
1459 in part. All arguments not mentioned below update the fields with the
1460 same name in the aqorders table of the Koha database.
1461
1462 If a partial order is received, splits the order into two.
1463
1464 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1465 C<$ordernumber>.
1466
1467 =cut
1468
1469
1470 sub ModReceiveOrder {
1471     my ( $params ) = @_;
1472     my $biblionumber = $params->{biblionumber};
1473     my $ordernumber = $params->{ordernumber};
1474     my $quantrec = $params->{quantityreceived};
1475     my $user = $params->{user};
1476     my $cost = $params->{cost};
1477     my $ecost = $params->{ecost};
1478     my $invoiceid = $params->{invoiceid};
1479     my $rrp = $params->{rrp};
1480     my $budget_id = $params->{budget_id};
1481     my $datereceived = $params->{datereceived};
1482     my $received_items = $params->{received_items};
1483     my $order_internalnote = $params->{order_internalnote};
1484     my $order_vendornote = $params->{order_vendornote};
1485
1486     my $dbh = C4::Context->dbh;
1487     $datereceived = C4::Dates->output('iso') unless $datereceived;
1488     my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1489     if ($suggestionid) {
1490         ModSuggestion( {suggestionid=>$suggestionid,
1491                         STATUS=>'AVAILABLE',
1492                         biblionumber=> $biblionumber}
1493                         );
1494     }
1495
1496     my $result_set = $dbh->selectall_arrayref(
1497 q{SELECT * FROM aqorders WHERE biblionumber=? AND aqorders.ordernumber=?},
1498         { Slice => {} }, $biblionumber, $ordernumber
1499     );
1500
1501     # we assume we have a unique order
1502     my $order = $result_set->[0];
1503
1504     my $new_ordernumber = $ordernumber;
1505     if ( $order->{quantity} > $quantrec ) {
1506         # Split order line in two parts: the first is the original order line
1507         # without received items (the quantity is decreased),
1508         # the second part is a new order line with quantity=quantityrec
1509         # (entirely received)
1510         my $query = q|
1511             UPDATE aqorders
1512             SET quantity = ?,
1513                 orderstatus = 'partial'|;
1514         $query .= q|, order_internalnote = ?| if defined $order_internalnote;
1515         $query .= q|, order_vendornote = ?| if defined $order_vendornote;
1516         $query .= q| WHERE ordernumber = ?|;
1517         my $sth = $dbh->prepare($query);
1518
1519         $sth->execute(
1520             $order->{quantity} - $quantrec,
1521             ( defined $order_internalnote ? $order_internalnote : () ),
1522             ( defined $order_vendornote ? $order_vendornote : () ),
1523             $ordernumber
1524         );
1525
1526         delete $order->{'ordernumber'};
1527         $order->{'budget_id'} = ( $budget_id || $order->{'budget_id'} );
1528         $order->{'quantity'} = $quantrec;
1529         $order->{'quantityreceived'} = $quantrec;
1530         $order->{'datereceived'} = $datereceived;
1531         $order->{'invoiceid'} = $invoiceid;
1532         $order->{'unitprice'} = $cost;
1533         $order->{'rrp'} = $rrp;
1534         $order->{ecost} = $ecost;
1535         $order->{'orderstatus'} = 'complete';
1536         my $basketno;
1537         ( $basketno, $new_ordernumber ) = NewOrder($order);
1538
1539         if ($received_items) {
1540             foreach my $itemnumber (@$received_items) {
1541                 ModItemOrder($itemnumber, $new_ordernumber);
1542             }
1543         }
1544     } else {
1545         my $query = q|
1546             update aqorders
1547             set quantityreceived=?,datereceived=?,invoiceid=?,
1548                 unitprice=?,rrp=?,ecost=?,budget_id=?,orderstatus='complete'|;
1549         $query .= q|, order_internalnote = ?| if defined $order_internalnote;
1550         $query .= q|, order_vendornote = ?| if defined $order_vendornote;
1551         $query .= q| where biblionumber=? and ordernumber=?|;
1552         my $sth = $dbh->prepare( $query );
1553         $sth->execute(
1554             $quantrec,
1555             $datereceived,
1556             $invoiceid,
1557             $cost,
1558             $rrp,
1559             $ecost,
1560             $budget_id,
1561             ( defined $order_internalnote ? $order_internalnote : () ),
1562             ( defined $order_vendornote ? $order_vendornote : () ),
1563             $biblionumber,
1564             $ordernumber
1565         );
1566     }
1567     return ($datereceived, $new_ordernumber);
1568 }
1569
1570 =head3 CancelReceipt
1571
1572     my $parent_ordernumber = CancelReceipt($ordernumber);
1573
1574     Cancel an order line receipt and update the parent order line, as if no
1575     receipt was made.
1576     If items are created at receipt (AcqCreateItem = receiving) then delete
1577     these items.
1578
1579 =cut
1580
1581 sub CancelReceipt {
1582     my $ordernumber = shift;
1583
1584     return unless $ordernumber;
1585
1586     my $dbh = C4::Context->dbh;
1587     my $query = qq{
1588         SELECT datereceived, parent_ordernumber, quantity
1589         FROM aqorders
1590         WHERE ordernumber = ?
1591     };
1592     my $sth = $dbh->prepare($query);
1593     $sth->execute($ordernumber);
1594     my $order = $sth->fetchrow_hashref;
1595     unless($order) {
1596         warn "CancelReceipt: order $ordernumber does not exist";
1597         return;
1598     }
1599     unless($order->{'datereceived'}) {
1600         warn "CancelReceipt: order $ordernumber is not received";
1601         return;
1602     }
1603
1604     my $parent_ordernumber = $order->{'parent_ordernumber'};
1605
1606     if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1607         # The order line has no parent, just mark it as not received
1608         $query = qq{
1609             UPDATE aqorders
1610             SET quantityreceived = ?,
1611                 datereceived = ?,
1612                 invoiceid = ?,
1613                 orderstatus = 'ordered'
1614             WHERE ordernumber = ?
1615         };
1616         $sth = $dbh->prepare($query);
1617         $sth->execute(0, undef, undef, $ordernumber);
1618         _cancel_items_receipt( $ordernumber );
1619     } else {
1620         # The order line has a parent, increase parent quantity and delete
1621         # the order line.
1622         $query = qq{
1623             SELECT quantity, datereceived
1624             FROM aqorders
1625             WHERE ordernumber = ?
1626         };
1627         $sth = $dbh->prepare($query);
1628         $sth->execute($parent_ordernumber);
1629         my $parent_order = $sth->fetchrow_hashref;
1630         unless($parent_order) {
1631             warn "Parent order $parent_ordernumber does not exist.";
1632             return;
1633         }
1634         if($parent_order->{'datereceived'}) {
1635             warn "CancelReceipt: parent order is received.".
1636                 " Can't cancel receipt.";
1637             return;
1638         }
1639         $query = qq{
1640             UPDATE aqorders
1641             SET quantity = ?,
1642                 orderstatus = 'ordered'
1643             WHERE ordernumber = ?
1644         };
1645         $sth = $dbh->prepare($query);
1646         my $rv = $sth->execute(
1647             $order->{'quantity'} + $parent_order->{'quantity'},
1648             $parent_ordernumber
1649         );
1650         unless($rv) {
1651             warn "Cannot update parent order line, so do not cancel".
1652                 " receipt";
1653             return;
1654         }
1655         _cancel_items_receipt( $ordernumber, $parent_ordernumber );
1656         # Delete order line
1657         $query = qq{
1658             DELETE FROM aqorders
1659             WHERE ordernumber = ?
1660         };
1661         $sth = $dbh->prepare($query);
1662         $sth->execute($ordernumber);
1663
1664     }
1665
1666     return $parent_ordernumber;
1667 }
1668
1669 sub _cancel_items_receipt {
1670     my ( $ordernumber, $parent_ordernumber ) = @_;
1671     $parent_ordernumber ||= $ordernumber;
1672
1673     my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1674     if(C4::Context->preference('AcqCreateItem') eq 'receiving') {
1675         # Remove items that were created at receipt
1676         my $query = qq{
1677             DELETE FROM items, aqorders_items
1678             USING items, aqorders_items
1679             WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1680         };
1681         my $dbh = C4::Context->dbh;
1682         my $sth = $dbh->prepare($query);
1683         foreach my $itemnumber (@itemnumbers) {
1684             $sth->execute($itemnumber, $itemnumber);
1685         }
1686     } else {
1687         # Update items
1688         foreach my $itemnumber (@itemnumbers) {
1689             ModItemOrder($itemnumber, $parent_ordernumber);
1690         }
1691     }
1692 }
1693
1694 #------------------------------------------------------------#
1695
1696 =head3 SearchOrders
1697
1698 @results = &SearchOrders({
1699     ordernumber => $ordernumber,
1700     search => $search,
1701     biblionumber => $biblionumber,
1702     ean => $ean,
1703     booksellerid => $booksellerid,
1704     basketno => $basketno,
1705     owner => $owner,
1706     pending => $pending
1707     ordered => $ordered
1708 });
1709
1710 Searches for orders.
1711
1712 C<$owner> Finds order for the logged in user.
1713 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1714 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1715
1716
1717 C<@results> is an array of references-to-hash with the keys are fields
1718 from aqorders, biblio, biblioitems and aqbasket tables.
1719
1720 =cut
1721
1722 sub SearchOrders {
1723     my ( $params ) = @_;
1724     my $ordernumber = $params->{ordernumber};
1725     my $search = $params->{search};
1726     my $ean = $params->{ean};
1727     my $booksellerid = $params->{booksellerid};
1728     my $basketno = $params->{basketno};
1729     my $basketname = $params->{basketname};
1730     my $basketgroupname = $params->{basketgroupname};
1731     my $owner = $params->{owner};
1732     my $pending = $params->{pending};
1733     my $ordered = $params->{ordered};
1734     my $biblionumber = $params->{biblionumber};
1735
1736     my $dbh = C4::Context->dbh;
1737     my @args = ();
1738     my $query = q{
1739         SELECT aqbasket.basketno,
1740                borrowers.surname,
1741                borrowers.firstname,
1742                biblio.*,
1743                biblioitems.isbn,
1744                biblioitems.biblioitemnumber,
1745                aqbasket.authorisedby,
1746                aqbasket.booksellerid,
1747                aqbasket.closedate,
1748                aqbasket.creationdate,
1749                aqbasket.basketname,
1750                aqbasketgroups.id as basketgroupid,
1751                aqbasketgroups.name as basketgroupname,
1752                aqorders.*
1753         FROM aqorders
1754             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1755             LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1756             LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1757             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1758             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1759     };
1760
1761     # If we search on ordernumber, we retrieve the transfered order if a transfer has been done.
1762     $query .= q{
1763             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1764     } if $ordernumber;
1765
1766     $query .= q{
1767         WHERE (datecancellationprinted is NULL)
1768     };
1769
1770     if ( $pending or $ordered ) {
1771         $query .= q{ AND (quantity > quantityreceived OR quantityreceived is NULL)};
1772     }
1773     if ( $ordered ) {
1774         $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1775     }
1776
1777     my $userenv = C4::Context->userenv;
1778     if ( C4::Context->preference("IndependentBranches") ) {
1779         unless ( C4::Context->IsSuperLibrarian() ) {
1780             $query .= q{
1781                 AND (
1782                     borrowers.branchcode = ?
1783                     OR borrowers.branchcode  = ''
1784                 )
1785             };
1786             push @args, $userenv->{branch};
1787         }
1788     }
1789
1790     if ( $ordernumber ) {
1791         $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1792         push @args, ( $ordernumber, $ordernumber );
1793     }
1794     if ( $biblionumber ) {
1795         $query .= 'AND aqorders.biblionumber = ?';
1796         push @args, $biblionumber;
1797     }
1798     if( $search ) {
1799         $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1800         push @args, ("%$search%","%$search%","%$search%");
1801     }
1802     if ( $ean ) {
1803         $query .= ' AND biblioitems.ean = ?';
1804         push @args, $ean;
1805     }
1806     if ( $booksellerid ) {
1807         $query .= 'AND aqbasket.booksellerid = ?';
1808         push @args, $booksellerid;
1809     }
1810     if( $basketno ) {
1811         $query .= 'AND aqbasket.basketno = ?';
1812         push @args, $basketno;
1813     }
1814     if( $basketname ) {
1815         $query .= 'AND aqbasket.basketname LIKE ?';
1816         push @args, "%$basketname%";
1817     }
1818     if( $basketgroupname ) {
1819         $query .= ' AND aqbasketgroups.name LIKE ?';
1820         push @args, "%$basketgroupname%";
1821     }
1822
1823     if ( $owner ) {
1824         $query .= ' AND aqbasket.authorisedby=? ';
1825         push @args, $userenv->{'number'};
1826     }
1827
1828     $query .= ' ORDER BY aqbasket.basketno';
1829
1830     my $sth = $dbh->prepare($query);
1831     $sth->execute(@args);
1832     return $sth->fetchall_arrayref({});
1833 }
1834
1835 #------------------------------------------------------------#
1836
1837 =head3 DelOrder
1838
1839   &DelOrder($biblionumber, $ordernumber);
1840
1841 Cancel the order with the given order and biblio numbers. It does not
1842 delete any entries in the aqorders table, it merely marks them as
1843 cancelled.
1844
1845 =cut
1846
1847 sub DelOrder {
1848     my ( $bibnum, $ordernumber ) = @_;
1849     my $dbh = C4::Context->dbh;
1850     my $query = "
1851         UPDATE aqorders
1852         SET    datecancellationprinted=now(), orderstatus='cancelled'
1853         WHERE  biblionumber=? AND ordernumber=?
1854     ";
1855     my $sth = $dbh->prepare($query);
1856     $sth->execute( $bibnum, $ordernumber );
1857     my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1858     foreach my $itemnumber (@itemnumbers){
1859         C4::Items::DelItem( $dbh, $bibnum, $itemnumber );
1860     }
1861     return;
1862 }
1863
1864 =head3 TransferOrder
1865
1866     my $newordernumber = TransferOrder($ordernumber, $basketno);
1867
1868 Transfer an order line to a basket.
1869 Mark $ordernumber as cancelled with an internal note 'Cancelled and transfered
1870 to BOOKSELLER on DATE' and create new order with internal note
1871 'Transfered from BOOKSELLER on DATE'.
1872 Move all attached items to the new order.
1873 Received orders cannot be transfered.
1874 Return the ordernumber of created order.
1875
1876 =cut
1877
1878 sub TransferOrder {
1879     my ($ordernumber, $basketno) = @_;
1880
1881     return unless ($ordernumber and $basketno);
1882
1883     my $order = GetOrder( $ordernumber );
1884     return if $order->{datereceived};
1885     my $basket = GetBasket($basketno);
1886     return unless $basket;
1887
1888     my $dbh = C4::Context->dbh;
1889     my ($query, $sth, $rv);
1890
1891     $query = q{
1892         UPDATE aqorders
1893         SET datecancellationprinted = CAST(NOW() AS date)
1894         WHERE ordernumber = ?
1895     };
1896     $sth = $dbh->prepare($query);
1897     $rv = $sth->execute($ordernumber);
1898
1899     delete $order->{'ordernumber'};
1900     delete $order->{parent_ordernumber};
1901     $order->{'basketno'} = $basketno;
1902     my $newordernumber;
1903     (undef, $newordernumber) = NewOrder($order);
1904
1905     $query = q{
1906         UPDATE aqorders_items
1907         SET ordernumber = ?
1908         WHERE ordernumber = ?
1909     };
1910     $sth = $dbh->prepare($query);
1911     $sth->execute($newordernumber, $ordernumber);
1912
1913     $query = q{
1914         INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1915         VALUES (?, ?)
1916     };
1917     $sth = $dbh->prepare($query);
1918     $sth->execute($ordernumber, $newordernumber);
1919
1920     return $newordernumber;
1921 }
1922
1923 =head2 FUNCTIONS ABOUT PARCELS
1924
1925 =cut
1926
1927 #------------------------------------------------------------#
1928
1929 =head3 GetParcel
1930
1931   @results = &GetParcel($booksellerid, $code, $date);
1932
1933 Looks up all of the received items from the supplier with the given
1934 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1935
1936 C<@results> is an array of references-to-hash. The keys of each element are fields from
1937 the aqorders, biblio, and biblioitems tables of the Koha database.
1938
1939 C<@results> is sorted alphabetically by book title.
1940
1941 =cut
1942
1943 sub GetParcel {
1944     #gets all orders from a certain supplier, orders them alphabetically
1945     my ( $supplierid, $code, $datereceived ) = @_;
1946     my $dbh     = C4::Context->dbh;
1947     my @results = ();
1948     $code .= '%'
1949     if $code;  # add % if we search on a given code (otherwise, let him empty)
1950     my $strsth ="
1951         SELECT  authorisedby,
1952                 creationdate,
1953                 aqbasket.basketno,
1954                 closedate,surname,
1955                 firstname,
1956                 aqorders.biblionumber,
1957                 aqorders.ordernumber,
1958                 aqorders.parent_ordernumber,
1959                 aqorders.quantity,
1960                 aqorders.quantityreceived,
1961                 aqorders.unitprice,
1962                 aqorders.listprice,
1963                 aqorders.rrp,
1964                 aqorders.ecost,
1965                 aqorders.gstrate,
1966                 biblio.title
1967         FROM aqorders
1968         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1969         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1970         LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1971         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1972         WHERE
1973             aqbasket.booksellerid = ?
1974             AND aqinvoices.invoicenumber LIKE ?
1975             AND aqorders.datereceived = ? ";
1976
1977     my @query_params = ( $supplierid, $code, $datereceived );
1978     if ( C4::Context->preference("IndependentBranches") ) {
1979         unless ( C4::Context->IsSuperLibrarian() ) {
1980             $strsth .= " and (borrowers.branchcode = ?
1981                         or borrowers.branchcode  = '')";
1982             push @query_params, C4::Context->userenv->{branch};
1983         }
1984     }
1985     $strsth .= " ORDER BY aqbasket.basketno";
1986     my $result_set = $dbh->selectall_arrayref(
1987         $strsth,
1988         { Slice => {} },
1989         @query_params);
1990
1991     return @{$result_set};
1992 }
1993
1994 #------------------------------------------------------------#
1995
1996 =head3 GetParcels
1997
1998   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1999
2000 get a lists of parcels.
2001
2002 * Input arg :
2003
2004 =over
2005
2006 =item $bookseller
2007 is the bookseller this function has to get parcels.
2008
2009 =item $order
2010 To know on what criteria the results list has to be ordered.
2011
2012 =item $code
2013 is the booksellerinvoicenumber.
2014
2015 =item $datefrom & $dateto
2016 to know on what date this function has to filter its search.
2017
2018 =back
2019
2020 * return:
2021 a pointer on a hash list containing parcel informations as such :
2022
2023 =over
2024
2025 =item Creation date
2026
2027 =item Last operation
2028
2029 =item Number of biblio
2030
2031 =item Number of items
2032
2033 =back
2034
2035 =cut
2036
2037 sub GetParcels {
2038     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
2039     my $dbh    = C4::Context->dbh;
2040     my @query_params = ();
2041     my $strsth ="
2042         SELECT  aqinvoices.invoicenumber,
2043                 datereceived,purchaseordernumber,
2044                 count(DISTINCT biblionumber) AS biblio,
2045                 sum(quantity) AS itemsexpected,
2046                 sum(quantityreceived) AS itemsreceived
2047         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
2048         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2049         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
2050     ";
2051     push @query_params, $bookseller;
2052
2053     if ( defined $code ) {
2054         $strsth .= ' and aqinvoices.invoicenumber like ? ';
2055         # add a % to the end of the code to allow stemming.
2056         push @query_params, "$code%";
2057     }
2058
2059     if ( defined $datefrom ) {
2060         $strsth .= ' and datereceived >= ? ';
2061         push @query_params, $datefrom;
2062     }
2063
2064     if ( defined $dateto ) {
2065         $strsth .=  'and datereceived <= ? ';
2066         push @query_params, $dateto;
2067     }
2068
2069     $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
2070
2071     # can't use a placeholder to place this column name.
2072     # but, we could probably be checking to make sure it is a column that will be fetched.
2073     $strsth .= "order by $order " if ($order);
2074
2075     my $sth = $dbh->prepare($strsth);
2076
2077     $sth->execute( @query_params );
2078     my $results = $sth->fetchall_arrayref({});
2079     return @{$results};
2080 }
2081
2082 #------------------------------------------------------------#
2083
2084 =head3 GetLateOrders
2085
2086   @results = &GetLateOrders;
2087
2088 Searches for bookseller with late orders.
2089
2090 return:
2091 the table of supplier with late issues. This table is full of hashref.
2092
2093 =cut
2094
2095 sub GetLateOrders {
2096     my $delay      = shift;
2097     my $supplierid = shift;
2098     my $branch     = shift;
2099     my $estimateddeliverydatefrom = shift;
2100     my $estimateddeliverydateto = shift;
2101
2102     my $dbh = C4::Context->dbh;
2103
2104     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
2105     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
2106
2107     my @query_params = ();
2108     my $select = "
2109     SELECT aqbasket.basketno,
2110         aqorders.ordernumber,
2111         DATE(aqbasket.closedate)  AS orderdate,
2112         aqbasket.basketname       AS basketname,
2113         aqbasket.basketgroupid    AS basketgroupid,
2114         aqbasketgroups.name       AS basketgroupname,
2115         aqorders.rrp              AS unitpricesupplier,
2116         aqorders.ecost            AS unitpricelib,
2117         aqorders.claims_count     AS claims_count,
2118         aqorders.claimed_date     AS claimed_date,
2119         aqbudgets.budget_name     AS budget,
2120         borrowers.branchcode      AS branch,
2121         aqbooksellers.name        AS supplier,
2122         aqbooksellers.id          AS supplierid,
2123         biblio.author, biblio.title,
2124         biblioitems.publishercode AS publisher,
2125         biblioitems.publicationyear,
2126         ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
2127     ";
2128     my $from = "
2129     FROM
2130         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
2131         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
2132         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
2133         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
2134         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
2135         LEFT JOIN aqbasketgroups      ON aqbasket.basketgroupid      = aqbasketgroups.id
2136         WHERE aqorders.basketno = aqbasket.basketno
2137         AND ( datereceived = ''
2138             OR datereceived IS NULL
2139             OR aqorders.quantityreceived < aqorders.quantity
2140         )
2141         AND aqbasket.closedate IS NOT NULL
2142         AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
2143     ";
2144     my $having = "";
2145     if ($dbdriver eq "mysql") {
2146         $select .= "
2147         aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity,
2148         (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
2149         DATEDIFF(CAST(now() AS date),closedate) AS latesince
2150         ";
2151         if ( defined $delay ) {
2152             $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
2153             push @query_params, $delay;
2154         }
2155         $having = "
2156         HAVING quantity          <> 0
2157             AND unitpricesupplier <> 0
2158             AND unitpricelib      <> 0
2159         ";
2160     } else {
2161         # FIXME: account for IFNULL as above
2162         $select .= "
2163                 aqorders.quantity                AS quantity,
2164                 aqorders.quantity * aqorders.rrp AS subtotal,
2165                 (CAST(now() AS date) - closedate)            AS latesince
2166         ";
2167         if ( defined $delay ) {
2168             $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
2169             push @query_params, $delay;
2170         }
2171     }
2172     if (defined $supplierid) {
2173         $from .= ' AND aqbasket.booksellerid = ? ';
2174         push @query_params, $supplierid;
2175     }
2176     if (defined $branch) {
2177         $from .= ' AND borrowers.branchcode LIKE ? ';
2178         push @query_params, $branch;
2179     }
2180
2181     if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
2182         $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
2183     }
2184     if ( defined $estimateddeliverydatefrom ) {
2185         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
2186         push @query_params, $estimateddeliverydatefrom;
2187     }
2188     if ( defined $estimateddeliverydateto ) {
2189         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
2190         push @query_params, $estimateddeliverydateto;
2191     }
2192     if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
2193         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
2194     }
2195     if (C4::Context->preference("IndependentBranches")
2196             && !C4::Context->IsSuperLibrarian() ) {
2197         $from .= ' AND borrowers.branchcode LIKE ? ';
2198         push @query_params, C4::Context->userenv->{branch};
2199     }
2200     $from .= " AND orderstatus <> 'cancelled' ";
2201     my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
2202     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
2203     my $sth = $dbh->prepare($query);
2204     $sth->execute(@query_params);
2205     my @results;
2206     while (my $data = $sth->fetchrow_hashref) {
2207         push @results, $data;
2208     }
2209     return @results;
2210 }
2211
2212 #------------------------------------------------------------#
2213
2214 =head3 GetHistory
2215
2216   (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( %params );
2217
2218 Retreives some acquisition history information
2219
2220 params:
2221   title
2222   author
2223   name
2224   isbn
2225   ean
2226   from_placed_on
2227   to_placed_on
2228   basket                  - search both basket name and number
2229   booksellerinvoicenumber
2230   basketgroupname
2231   budget
2232   orderstatus (note that orderstatus '' will retrieve orders
2233                of any status except cancelled)
2234   biblionumber
2235   get_canceled_order (if set to a true value, cancelled orders will
2236                       be included)
2237
2238 returns:
2239     $order_loop is a list of hashrefs that each look like this:
2240             {
2241                 'author'           => 'Twain, Mark',
2242                 'basketno'         => '1',
2243                 'biblionumber'     => '215',
2244                 'count'            => 1,
2245                 'creationdate'     => 'MM/DD/YYYY',
2246                 'datereceived'     => undef,
2247                 'ecost'            => '1.00',
2248                 'id'               => '1',
2249                 'invoicenumber'    => undef,
2250                 'name'             => '',
2251                 'ordernumber'      => '1',
2252                 'quantity'         => 1,
2253                 'quantityreceived' => undef,
2254                 'title'            => 'The Adventures of Huckleberry Finn'
2255             }
2256     $total_qty is the sum of all of the quantities in $order_loop
2257     $total_price is the cost of each in $order_loop times the quantity
2258     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
2259
2260 =cut
2261
2262 sub GetHistory {
2263 # don't run the query if there are no parameters (list would be too long for sure !)
2264     croak "No search params" unless @_;
2265     my %params = @_;
2266     my $title = $params{title};
2267     my $author = $params{author};
2268     my $isbn   = $params{isbn};
2269     my $ean    = $params{ean};
2270     my $name = $params{name};
2271     my $from_placed_on = $params{from_placed_on};
2272     my $to_placed_on = $params{to_placed_on};
2273     my $basket = $params{basket};
2274     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2275     my $basketgroupname = $params{basketgroupname};
2276     my $budget = $params{budget};
2277     my $orderstatus = $params{orderstatus};
2278     my $biblionumber = $params{biblionumber};
2279     my $get_canceled_order = $params{get_canceled_order} || 0;
2280     my $ordernumber = $params{ordernumber};
2281     my $search_children_too = $params{search_children_too} || 0;
2282
2283     my @order_loop;
2284     my $total_qty         = 0;
2285     my $total_qtyreceived = 0;
2286     my $total_price       = 0;
2287
2288     my $dbh   = C4::Context->dbh;
2289     my $query ="
2290         SELECT
2291             COALESCE(biblio.title,     deletedbiblio.title)     AS title,
2292             COALESCE(biblio.author,    deletedbiblio.author)    AS author,
2293             COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2294             COALESCE(biblioitems.ean,  deletedbiblioitems.ean)  AS ean,
2295             aqorders.basketno,
2296             aqbasket.basketname,
2297             aqbasket.basketgroupid,
2298             aqbasketgroups.name as groupname,
2299             aqbooksellers.name,
2300             aqbasket.creationdate,
2301             aqorders.datereceived,
2302             aqorders.quantity,
2303             aqorders.quantityreceived,
2304             aqorders.ecost,
2305             aqorders.ordernumber,
2306             aqorders.invoiceid,
2307             aqinvoices.invoicenumber,
2308             aqbooksellers.id as id,
2309             aqorders.biblionumber,
2310             aqorders.orderstatus,
2311             aqorders.parent_ordernumber,
2312             aqbudgets.budget_name
2313             ";
2314     $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2315     $query .= "
2316         FROM aqorders
2317         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2318         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2319         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2320         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2321         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2322         LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2323         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2324         LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2325         LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2326         ";
2327
2328     if ( C4::Context->preference("IndependentBranches") ) {
2329         $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber";
2330     }
2331
2332     $query .= " WHERE 1 ";
2333
2334     unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2335         $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2336     }
2337
2338     my @query_params  = ();
2339
2340     if ( $biblionumber ) {
2341         $query .= " AND biblio.biblionumber = ?";
2342         push @query_params, $biblionumber;
2343     }
2344
2345     if ( $title ) {
2346         $query .= " AND biblio.title LIKE ? ";
2347         $title =~ s/\s+/%/g;
2348         push @query_params, "%$title%";
2349     }
2350
2351     if ( $author ) {
2352         $query .= " AND biblio.author LIKE ? ";
2353         push @query_params, "%$author%";
2354     }
2355
2356     if ( $isbn ) {
2357         $query .= " AND biblioitems.isbn LIKE ? ";
2358         push @query_params, "%$isbn%";
2359     }
2360     if ( $ean ) {
2361         $query .= " AND biblioitems.ean = ? ";
2362         push @query_params, "$ean";
2363     }
2364     if ( $name ) {
2365         $query .= " AND aqbooksellers.name LIKE ? ";
2366         push @query_params, "%$name%";
2367     }
2368
2369     if ( $budget ) {
2370         $query .= " AND aqbudgets.budget_id = ? ";
2371         push @query_params, "$budget";
2372     }
2373
2374     if ( $from_placed_on ) {
2375         $query .= " AND creationdate >= ? ";
2376         push @query_params, $from_placed_on;
2377     }
2378
2379     if ( $to_placed_on ) {
2380         $query .= " AND creationdate <= ? ";
2381         push @query_params, $to_placed_on;
2382     }
2383
2384     if ( defined $orderstatus and $orderstatus ne '') {
2385         $query .= " AND aqorders.orderstatus = ? ";
2386         push @query_params, "$orderstatus";
2387     }
2388
2389     if ($basket) {
2390         if ($basket =~ m/^\d+$/) {
2391             $query .= " AND aqorders.basketno = ? ";
2392             push @query_params, $basket;
2393         } else {
2394             $query .= " AND aqbasket.basketname LIKE ? ";
2395             push @query_params, "%$basket%";
2396         }
2397     }
2398
2399     if ($booksellerinvoicenumber) {
2400         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2401         push @query_params, "%$booksellerinvoicenumber%";
2402     }
2403
2404     if ($basketgroupname) {
2405         $query .= " AND aqbasketgroups.name LIKE ? ";
2406         push @query_params, "%$basketgroupname%";
2407     }
2408
2409     if ($ordernumber) {
2410         $query .= " AND (aqorders.ordernumber = ? ";
2411         push @query_params, $ordernumber;
2412         if ($search_children_too) {
2413             $query .= " OR aqorders.parent_ordernumber = ? ";
2414             push @query_params, $ordernumber;
2415         }
2416         $query .= ") ";
2417     }
2418
2419
2420     if ( C4::Context->preference("IndependentBranches") ) {
2421         unless ( C4::Context->IsSuperLibrarian() ) {
2422             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2423             push @query_params, C4::Context->userenv->{branch};
2424         }
2425     }
2426     $query .= " ORDER BY id";
2427     my $sth = $dbh->prepare($query);
2428     $sth->execute( @query_params );
2429     my $cnt = 1;
2430     while ( my $line = $sth->fetchrow_hashref ) {
2431         $line->{count} = $cnt++;
2432         $line->{toggle} = 1 if $cnt % 2;
2433         push @order_loop, $line;
2434         $total_qty         += ( $line->{quantity} ) ? $line->{quantity} : 0;
2435         $total_qtyreceived += ( $line->{quantityreceived} ) ? $line->{quantityreceived} : 0;
2436         $total_price       += ( $line->{quantity} and $line->{ecost} ) ? $line->{quantity} * $line->{ecost} : 0;
2437     }
2438     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
2439 }
2440
2441 =head2 GetRecentAcqui
2442
2443   $results = GetRecentAcqui($days);
2444
2445 C<$results> is a ref to a table which containts hashref
2446
2447 =cut
2448
2449 sub GetRecentAcqui {
2450     my $limit  = shift;
2451     my $dbh    = C4::Context->dbh;
2452     my $query = "
2453         SELECT *
2454         FROM   biblio
2455         ORDER BY timestamp DESC
2456         LIMIT  0,".$limit;
2457
2458     my $sth = $dbh->prepare($query);
2459     $sth->execute;
2460     my $results = $sth->fetchall_arrayref({});
2461     return $results;
2462 }
2463
2464 =head3 GetContracts
2465
2466   $contractlist = &GetContracts($booksellerid, $activeonly);
2467
2468 Looks up the contracts that belong to a bookseller
2469
2470 Returns a list of contracts
2471
2472 =over
2473
2474 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
2475
2476 =item C<$activeonly> if exists get only contracts that are still active.
2477
2478 =back
2479
2480 =cut
2481
2482 sub GetContracts {
2483     my ( $booksellerid, $activeonly ) = @_;
2484     my $dbh = C4::Context->dbh;
2485     my $query;
2486     if (! $activeonly) {
2487         $query = "
2488             SELECT *
2489             FROM   aqcontract
2490             WHERE  booksellerid=?
2491         ";
2492     } else {
2493         $query = "SELECT *
2494             FROM aqcontract
2495             WHERE booksellerid=?
2496                 AND contractenddate >= CURDATE( )";
2497     }
2498     my $result_set =
2499       $dbh->selectall_arrayref( $query, { Slice => {} }, $booksellerid );
2500     return @{$result_set};
2501 }
2502
2503 #------------------------------------------------------------#
2504
2505 =head3 GetContract
2506
2507   $contract = &GetContract($contractID);
2508
2509 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
2510
2511 Returns a contract
2512
2513 =cut
2514
2515 sub GetContract {
2516     my ( $contractno ) = @_;
2517     my $dbh = C4::Context->dbh;
2518     my $query = "
2519         SELECT *
2520         FROM   aqcontract
2521         WHERE  contractnumber=?
2522         ";
2523
2524     my $sth = $dbh->prepare($query);
2525     $sth->execute( $contractno );
2526     my $result = $sth->fetchrow_hashref;
2527     return $result;
2528 }
2529
2530 =head3 AddClaim
2531
2532 =over
2533
2534 &AddClaim($ordernumber);
2535
2536 Add a claim for an order
2537
2538 =back
2539
2540 =cut
2541
2542 sub AddClaim {
2543     my ($ordernumber) = @_;
2544     my $dbh          = C4::Context->dbh;
2545     my $query        = "
2546         UPDATE aqorders SET
2547             claims_count = claims_count + 1,
2548             claimed_date = CURDATE()
2549         WHERE ordernumber = ?
2550         ";
2551     my $sth = $dbh->prepare($query);
2552     $sth->execute($ordernumber);
2553 }
2554
2555 =head3 GetInvoices
2556
2557     my @invoices = GetInvoices(
2558         invoicenumber => $invoicenumber,
2559         supplierid => $supplierid,
2560         suppliername => $suppliername,
2561         shipmentdatefrom => $shipmentdatefrom, # ISO format
2562         shipmentdateto => $shipmentdateto, # ISO format
2563         billingdatefrom => $billingdatefrom, # ISO format
2564         billingdateto => $billingdateto, # ISO format
2565         isbneanissn => $isbn_or_ean_or_issn,
2566         title => $title,
2567         author => $author,
2568         publisher => $publisher,
2569         publicationyear => $publicationyear,
2570         branchcode => $branchcode,
2571         order_by => $order_by
2572     );
2573
2574 Return a list of invoices that match all given criteria.
2575
2576 $order_by is "column_name (asc|desc)", where column_name is any of
2577 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2578 'shipmentcost', 'shipmentcost_budgetid'.
2579
2580 asc is the default if omitted
2581
2582 =cut
2583
2584 sub GetInvoices {
2585     my %args = @_;
2586
2587     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2588         closedate shipmentcost shipmentcost_budgetid);
2589
2590     my $dbh = C4::Context->dbh;
2591     my $query = qq{
2592         SELECT aqinvoices.*, aqbooksellers.name AS suppliername,
2593           COUNT(
2594             DISTINCT IF(
2595               aqorders.datereceived IS NOT NULL,
2596               aqorders.biblionumber,
2597               NULL
2598             )
2599           ) AS receivedbiblios,
2600           COUNT(
2601              DISTINCT IF(
2602               aqorders.subscriptionid IS NOT NULL,
2603               aqorders.subscriptionid,
2604               NULL
2605             )
2606           ) AS is_linked_to_subscriptions,
2607           SUM(aqorders.quantityreceived) AS receiveditems
2608         FROM aqinvoices
2609           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2610           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2611           LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2612           LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2613           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2614           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2615           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2616     };
2617
2618     my @bind_args;
2619     my @bind_strs;
2620     if($args{supplierid}) {
2621         push @bind_strs, " aqinvoices.booksellerid = ? ";
2622         push @bind_args, $args{supplierid};
2623     }
2624     if($args{invoicenumber}) {
2625         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2626         push @bind_args, "%$args{invoicenumber}%";
2627     }
2628     if($args{suppliername}) {
2629         push @bind_strs, " aqbooksellers.name LIKE ? ";
2630         push @bind_args, "%$args{suppliername}%";
2631     }
2632     if($args{shipmentdatefrom}) {
2633         push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2634         push @bind_args, $args{shipmentdatefrom};
2635     }
2636     if($args{shipmentdateto}) {
2637         push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2638         push @bind_args, $args{shipmentdateto};
2639     }
2640     if($args{billingdatefrom}) {
2641         push @bind_strs, " aqinvoices.billingdate >= ? ";
2642         push @bind_args, $args{billingdatefrom};
2643     }
2644     if($args{billingdateto}) {
2645         push @bind_strs, " aqinvoices.billingdate <= ? ";
2646         push @bind_args, $args{billingdateto};
2647     }
2648     if($args{isbneanissn}) {
2649         push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2650         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2651     }
2652     if($args{title}) {
2653         push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2654         push @bind_args, $args{title};
2655     }
2656     if($args{author}) {
2657         push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2658         push @bind_args, $args{author};
2659     }
2660     if($args{publisher}) {
2661         push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2662         push @bind_args, $args{publisher};
2663     }
2664     if($args{publicationyear}) {
2665         push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2666         push @bind_args, $args{publicationyear}, $args{publicationyear};
2667     }
2668     if($args{branchcode}) {
2669         push @bind_strs, " borrowers.branchcode = ? ";
2670         push @bind_args, $args{branchcode};
2671     }
2672
2673     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2674     $query .= " GROUP BY aqinvoices.invoiceid ";
2675
2676     if($args{order_by}) {
2677         my ($column, $direction) = split / /, $args{order_by};
2678         if(grep /^$column$/, @columns) {
2679             $direction ||= 'ASC';
2680             $query .= " ORDER BY $column $direction";
2681         }
2682     }
2683
2684     my $sth = $dbh->prepare($query);
2685     $sth->execute(@bind_args);
2686
2687     my $results = $sth->fetchall_arrayref({});
2688     return @$results;
2689 }
2690
2691 =head3 GetInvoice
2692
2693     my $invoice = GetInvoice($invoiceid);
2694
2695 Get informations about invoice with given $invoiceid
2696
2697 Return a hash filled with aqinvoices.* fields
2698
2699 =cut
2700
2701 sub GetInvoice {
2702     my ($invoiceid) = @_;
2703     my $invoice;
2704
2705     return unless $invoiceid;
2706
2707     my $dbh = C4::Context->dbh;
2708     my $query = qq{
2709         SELECT *
2710         FROM aqinvoices
2711         WHERE invoiceid = ?
2712     };
2713     my $sth = $dbh->prepare($query);
2714     $sth->execute($invoiceid);
2715
2716     $invoice = $sth->fetchrow_hashref;
2717     return $invoice;
2718 }
2719
2720 =head3 GetInvoiceDetails
2721
2722     my $invoice = GetInvoiceDetails($invoiceid)
2723
2724 Return informations about an invoice + the list of related order lines
2725
2726 Orders informations are in $invoice->{orders} (array ref)
2727
2728 =cut
2729
2730 sub GetInvoiceDetails {
2731     my ($invoiceid) = @_;
2732
2733     if ( !defined $invoiceid ) {
2734         carp 'GetInvoiceDetails called without an invoiceid';
2735         return;
2736     }
2737
2738     my $dbh = C4::Context->dbh;
2739     my $query = q{
2740         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2741         FROM aqinvoices
2742           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2743         WHERE invoiceid = ?
2744     };
2745     my $sth = $dbh->prepare($query);
2746     $sth->execute($invoiceid);
2747
2748     my $invoice = $sth->fetchrow_hashref;
2749
2750     $query = q{
2751         SELECT aqorders.*, biblio.*, aqbasket.basketname
2752         FROM aqorders
2753           LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2754           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2755         WHERE invoiceid = ?
2756     };
2757     $sth = $dbh->prepare($query);
2758     $sth->execute($invoiceid);
2759     $invoice->{orders} = $sth->fetchall_arrayref({});
2760     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2761
2762     return $invoice;
2763 }
2764
2765 =head3 AddInvoice
2766
2767     my $invoiceid = AddInvoice(
2768         invoicenumber => $invoicenumber,
2769         booksellerid => $booksellerid,
2770         shipmentdate => $shipmentdate,
2771         billingdate => $billingdate,
2772         closedate => $closedate,
2773         shipmentcost => $shipmentcost,
2774         shipmentcost_budgetid => $shipmentcost_budgetid
2775     );
2776
2777 Create a new invoice and return its id or undef if it fails.
2778
2779 =cut
2780
2781 sub AddInvoice {
2782     my %invoice = @_;
2783
2784     return unless(%invoice and $invoice{invoicenumber});
2785
2786     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2787         closedate shipmentcost shipmentcost_budgetid);
2788
2789     my @set_strs;
2790     my @set_args;
2791     foreach my $key (keys %invoice) {
2792         if(0 < grep(/^$key$/, @columns)) {
2793             push @set_strs, "$key = ?";
2794             push @set_args, ($invoice{$key} || undef);
2795         }
2796     }
2797
2798     my $rv;
2799     if(@set_args > 0) {
2800         my $dbh = C4::Context->dbh;
2801         my $query = "INSERT INTO aqinvoices SET ";
2802         $query .= join (",", @set_strs);
2803         my $sth = $dbh->prepare($query);
2804         $rv = $sth->execute(@set_args);
2805         if($rv) {
2806             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2807         }
2808     }
2809     return $rv;
2810 }
2811
2812 =head3 ModInvoice
2813
2814     ModInvoice(
2815         invoiceid => $invoiceid,    # Mandatory
2816         invoicenumber => $invoicenumber,
2817         booksellerid => $booksellerid,
2818         shipmentdate => $shipmentdate,
2819         billingdate => $billingdate,
2820         closedate => $closedate,
2821         shipmentcost => $shipmentcost,
2822         shipmentcost_budgetid => $shipmentcost_budgetid
2823     );
2824
2825 Modify an invoice, invoiceid is mandatory.
2826
2827 Return undef if it fails.
2828
2829 =cut
2830
2831 sub ModInvoice {
2832     my %invoice = @_;
2833
2834     return unless(%invoice and $invoice{invoiceid});
2835
2836     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2837         closedate shipmentcost shipmentcost_budgetid);
2838
2839     my @set_strs;
2840     my @set_args;
2841     foreach my $key (keys %invoice) {
2842         if(0 < grep(/^$key$/, @columns)) {
2843             push @set_strs, "$key = ?";
2844             push @set_args, ($invoice{$key} || undef);
2845         }
2846     }
2847
2848     my $dbh = C4::Context->dbh;
2849     my $query = "UPDATE aqinvoices SET ";
2850     $query .= join(",", @set_strs);
2851     $query .= " WHERE invoiceid = ?";
2852
2853     my $sth = $dbh->prepare($query);
2854     $sth->execute(@set_args, $invoice{invoiceid});
2855 }
2856
2857 =head3 CloseInvoice
2858
2859     CloseInvoice($invoiceid);
2860
2861 Close an invoice.
2862
2863 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2864
2865 =cut
2866
2867 sub CloseInvoice {
2868     my ($invoiceid) = @_;
2869
2870     return unless $invoiceid;
2871
2872     my $dbh = C4::Context->dbh;
2873     my $query = qq{
2874         UPDATE aqinvoices
2875         SET closedate = CAST(NOW() AS DATE)
2876         WHERE invoiceid = ?
2877     };
2878     my $sth = $dbh->prepare($query);
2879     $sth->execute($invoiceid);
2880 }
2881
2882 =head3 ReopenInvoice
2883
2884     ReopenInvoice($invoiceid);
2885
2886 Reopen an invoice
2887
2888 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => C4::Dates->new()->output('iso'))
2889
2890 =cut
2891
2892 sub ReopenInvoice {
2893     my ($invoiceid) = @_;
2894
2895     return unless $invoiceid;
2896
2897     my $dbh = C4::Context->dbh;
2898     my $query = qq{
2899         UPDATE aqinvoices
2900         SET closedate = NULL
2901         WHERE invoiceid = ?
2902     };
2903     my $sth = $dbh->prepare($query);
2904     $sth->execute($invoiceid);
2905 }
2906
2907 =head3 DelInvoice
2908
2909     DelInvoice($invoiceid);
2910
2911 Delete an invoice if there are no items attached to it.
2912
2913 =cut
2914
2915 sub DelInvoice {
2916     my ($invoiceid) = @_;
2917
2918     return unless $invoiceid;
2919
2920     my $dbh   = C4::Context->dbh;
2921     my $query = qq{
2922         SELECT COUNT(*)
2923         FROM aqorders
2924         WHERE invoiceid = ?
2925     };
2926     my $sth = $dbh->prepare($query);
2927     $sth->execute($invoiceid);
2928     my $res = $sth->fetchrow_arrayref;
2929     if ( $res && $res->[0] == 0 ) {
2930         $query = qq{
2931             DELETE FROM aqinvoices
2932             WHERE invoiceid = ?
2933         };
2934         my $sth = $dbh->prepare($query);
2935         return ( $sth->execute($invoiceid) > 0 );
2936     }
2937     return;
2938 }
2939
2940 =head3 MergeInvoices
2941
2942     MergeInvoices($invoiceid, \@sourceids);
2943
2944 Merge the invoices identified by the IDs in \@sourceids into
2945 the invoice identified by $invoiceid.
2946
2947 =cut
2948
2949 sub MergeInvoices {
2950     my ($invoiceid, $sourceids) = @_;
2951
2952     return unless $invoiceid;
2953     foreach my $sourceid (@$sourceids) {
2954         next if $sourceid == $invoiceid;
2955         my $source = GetInvoiceDetails($sourceid);
2956         foreach my $order (@{$source->{'orders'}}) {
2957             $order->{'invoiceid'} = $invoiceid;
2958             ModOrder($order);
2959         }
2960         DelInvoice($source->{'invoiceid'});
2961     }
2962     return;
2963 }
2964
2965 =head3 GetBiblioCountByBasketno
2966
2967 $biblio_count = &GetBiblioCountByBasketno($basketno);
2968
2969 Looks up the biblio's count that has basketno value $basketno
2970
2971 Returns a quantity
2972
2973 =cut
2974
2975 sub GetBiblioCountByBasketno {
2976     my ($basketno) = @_;
2977     my $dbh          = C4::Context->dbh;
2978     my $query        = "
2979         SELECT COUNT( DISTINCT( biblionumber ) )
2980         FROM   aqorders
2981         WHERE  basketno = ?
2982             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
2983         ";
2984
2985     my $sth = $dbh->prepare($query);
2986     $sth->execute($basketno);
2987     return $sth->fetchrow;
2988 }
2989
2990 1;
2991 __END__
2992
2993 =head1 AUTHOR
2994
2995 Koha Development Team <http://koha-community.org/>
2996
2997 =cut