C4/Acquisition.pm

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