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