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