C4/Acquisition.pm

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