C4/Acquisition.pm

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