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