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