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->{'budget_id'} = ( $budget_id || $order->{'budget_id'} );
1272         $order->{'quantity'} = $quantrec;
1273         $order->{'quantityreceived'} = $quantrec;
1274         $order->{'datereceived'} = $datereceived;
1275         $order->{'invoiceid'} = $invoiceid;
1276         $order->{'unitprice'} = $cost;
1277         $order->{'rrp'} = $rrp;
1278         $order->{ecost} = $ecost;
1279         $order->{'orderstatus'} = 3;    # totally received
1280         my $basketno;
1281         ( $basketno, $new_ordernumber ) = NewOrder($order);
1282
1283         if ($received_items) {
1284             foreach my $itemnumber (@$received_items) {
1285                 ModItemOrder($itemnumber, $new_ordernumber);
1286             }
1287         }
1288     } else {
1289         $sth=$dbh->prepare("update aqorders
1290                             set quantityreceived=?,datereceived=?,invoiceid=?,
1291                                 unitprice=?,rrp=?,ecost=?,budget_id=?
1292                             where biblionumber=? and ordernumber=?");
1293         $sth->execute($quantrec,$datereceived,$invoiceid,$cost,$rrp,$ecost,$budget_id,$biblionumber,$ordernumber);
1294         $sth->finish;
1295     }
1296     return ($datereceived, $new_ordernumber);
1297 }
1298
1299 =head3 CancelReceipt
1300
1301     my $parent_ordernumber = CancelReceipt($ordernumber);
1302
1303     Cancel an order line receipt and update the parent order line, as if no
1304     receipt was made.
1305     If items are created at receipt (AcqCreateItem = receiving) then delete
1306     these items.
1307
1308 =cut
1309
1310 sub CancelReceipt {
1311     my $ordernumber = shift;
1312
1313     return unless $ordernumber;
1314
1315     my $dbh = C4::Context->dbh;
1316     my $query = qq{
1317         SELECT datereceived, parent_ordernumber, quantity
1318         FROM aqorders
1319         WHERE ordernumber = ?
1320     };
1321     my $sth = $dbh->prepare($query);
1322     $sth->execute($ordernumber);
1323     my $order = $sth->fetchrow_hashref;
1324     unless($order) {
1325         warn "CancelReceipt: order $ordernumber does not exist";
1326         return;
1327     }
1328     unless($order->{'datereceived'}) {
1329         warn "CancelReceipt: order $ordernumber is not received";
1330         return;
1331     }
1332
1333     my $parent_ordernumber = $order->{'parent_ordernumber'};
1334
1335     if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1336         # The order line has no parent, just mark it as not received
1337         $query = qq{
1338             UPDATE aqorders
1339             SET quantityreceived = ?,
1340                 datereceived = ?,
1341                 invoiceid = ?
1342             WHERE ordernumber = ?
1343         };
1344         $sth = $dbh->prepare($query);
1345         $sth->execute(0, undef, undef, $ordernumber);
1346     } else {
1347         # The order line has a parent, increase parent quantity and delete
1348         # the order line.
1349         $query = qq{
1350             SELECT quantity, datereceived
1351             FROM aqorders
1352             WHERE ordernumber = ?
1353         };
1354         $sth = $dbh->prepare($query);
1355         $sth->execute($parent_ordernumber);
1356         my $parent_order = $sth->fetchrow_hashref;
1357         unless($parent_order) {
1358             warn "Parent order $parent_ordernumber does not exist.";
1359             return;
1360         }
1361         if($parent_order->{'datereceived'}) {
1362             warn "CancelReceipt: parent order is received.".
1363                 " Can't cancel receipt.";
1364             return;
1365         }
1366         $query = qq{
1367             UPDATE aqorders
1368             SET quantity = ?
1369             WHERE ordernumber = ?
1370         };
1371         $sth = $dbh->prepare($query);
1372         my $rv = $sth->execute(
1373             $order->{'quantity'} + $parent_order->{'quantity'},
1374             $parent_ordernumber
1375         );
1376         unless($rv) {
1377             warn "Cannot update parent order line, so do not cancel".
1378                 " receipt";
1379             return;
1380         }
1381         if(C4::Context->preference('AcqCreateItem') eq 'receiving') {
1382             # Remove items that were created at receipt
1383             $query = qq{
1384                 DELETE FROM items, aqorders_items
1385                 USING items, aqorders_items
1386                 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1387             };
1388             $sth = $dbh->prepare($query);
1389             my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1390             foreach my $itemnumber (@itemnumbers) {
1391                 $sth->execute($itemnumber, $itemnumber);
1392             }
1393         } else {
1394             # Update items
1395             my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1396             foreach my $itemnumber (@itemnumbers) {
1397                 ModItemOrder($itemnumber, $parent_ordernumber);
1398             }
1399         }
1400         # Delete order line
1401         $query = qq{
1402             DELETE FROM aqorders
1403             WHERE ordernumber = ?
1404         };
1405         $sth = $dbh->prepare($query);
1406         $sth->execute($ordernumber);
1407
1408     }
1409
1410     return $parent_ordernumber;
1411 }
1412
1413 #------------------------------------------------------------#
1414
1415 =head3 SearchOrders
1416
1417 @results = &SearchOrders({
1418     ordernumber => $ordernumber,
1419     search => $search,
1420     biblionumber => $biblionumber,
1421     ean => $ean,
1422     booksellerid => $booksellerid,
1423     basketno => $basketno,
1424     owner => $owner,
1425     pending => $pending
1426 });
1427
1428 Searches for orders.
1429
1430 C<$owner> Finds order for the logged in user.
1431 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1432
1433
1434 C<@results> is an array of references-to-hash with the keys are fields
1435 from aqorders, biblio, biblioitems and aqbasket tables.
1436
1437 =cut
1438
1439 sub SearchOrders {
1440     my ( $params ) = @_;
1441     my $ordernumber = $params->{ordernumber};
1442     my $search = $params->{search};
1443     my $ean = $params->{ean};
1444     my $booksellerid = $params->{booksellerid};
1445     my $basketno = $params->{basketno};
1446     my $basketname = $params->{basketname};
1447     my $basketgroupname = $params->{basketgroupname};
1448     my $owner = $params->{owner};
1449     my $pending = $params->{pending};
1450
1451     my $dbh = C4::Context->dbh;
1452     my @args = ();
1453     my $query = q{
1454         SELECT aqbasket.basketno,
1455                borrowers.surname,
1456                borrowers.firstname,
1457                biblio.*,
1458                biblioitems.isbn,
1459                biblioitems.biblioitemnumber,
1460                aqbasket.closedate,
1461                aqbasket.creationdate,
1462                aqbasket.basketname,
1463                aqorders.*
1464         FROM aqorders
1465             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1466             LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1467             LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1468             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1469             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1470         WHERE (datecancellationprinted is NULL)
1471     };
1472
1473     $query .= q{
1474         AND (quantity > quantityreceived OR quantityreceived is NULL)
1475     } if $pending;
1476
1477     my $userenv = C4::Context->userenv;
1478     if ( C4::Context->preference("IndependentBranches") ) {
1479         if ( ( $userenv ) and ( $userenv->{flags} != 1 ) ) {
1480             $query .= q{
1481                 AND (
1482                     borrowers.branchcode = ?
1483                     OR borrowers.branchcode  = ''
1484                 )
1485             };
1486             push @args, $userenv->{branch};
1487         }
1488     }
1489
1490     if ( $ordernumber ) {
1491         $query .= ' AND (aqorders.ordernumber=?)';
1492         push @args, $ordernumber;
1493     }
1494     if( $search ) {
1495         $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1496         push @args, ("%$search%","%$search%","%$search%");
1497     }
1498     if ( $ean ) {
1499         $query .= ' AND biblioitems.ean = ?';
1500         push @args, $ean;
1501     }
1502     if ( $booksellerid ) {
1503         $query .= 'AND aqbasket.booksellerid = ?';
1504         push @args, $booksellerid;
1505     }
1506     if( $basketno ) {
1507         $query .= 'AND aqbasket.basketno = ?';
1508         push @args, $basketno;
1509     }
1510     if( $basketname ) {
1511         $query .= 'AND aqbasket.basketname LIKE ?';
1512         push @args, "%$basketname%";
1513     }
1514     if( $basketgroupname ) {
1515         $query .= ' AND aqbasketgroups.name LIKE ?';
1516         push @args, "%$basketgroupname%";
1517     }
1518
1519     if ( $owner ) {
1520         $query .= ' AND aqbasket.authorisedby=? ';
1521         push @args, $userenv->{'number'};
1522     }
1523
1524     $query .= ' ORDER BY aqbasket.basketno';
1525
1526     my $sth = $dbh->prepare($query);
1527     $sth->execute(@args);
1528     return $sth->fetchall_arrayref({});
1529 }
1530
1531 #------------------------------------------------------------#
1532
1533 =head3 DelOrder
1534
1535   &DelOrder($biblionumber, $ordernumber);
1536
1537 Cancel the order with the given order and biblio numbers. It does not
1538 delete any entries in the aqorders table, it merely marks them as
1539 cancelled.
1540
1541 =cut
1542
1543 sub DelOrder {
1544     my ( $bibnum, $ordernumber ) = @_;
1545     my $dbh = C4::Context->dbh;
1546     my $query = "
1547         UPDATE aqorders
1548         SET    datecancellationprinted=now()
1549         WHERE  biblionumber=? AND ordernumber=?
1550     ";
1551     my $sth = $dbh->prepare($query);
1552     $sth->execute( $bibnum, $ordernumber );
1553     $sth->finish;
1554     my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1555     foreach my $itemnumber (@itemnumbers){
1556         C4::Items::DelItem( $dbh, $bibnum, $itemnumber );
1557     }
1558
1559 }
1560
1561 =head3 TransferOrder
1562
1563     my $newordernumber = TransferOrder($ordernumber, $basketno);
1564
1565 Transfer an order line to a basket.
1566 Mark $ordernumber as cancelled with an internal note 'Cancelled and transfered
1567 to BOOKSELLER on DATE' and create new order with internal note
1568 'Transfered from BOOKSELLER on DATE'.
1569 Move all attached items to the new order.
1570 Received orders cannot be transfered.
1571 Return the ordernumber of created order.
1572
1573 =cut
1574
1575 sub TransferOrder {
1576     my ($ordernumber, $basketno) = @_;
1577
1578     return unless ($ordernumber and $basketno);
1579
1580     my $order = GetOrder( $ordernumber );
1581     return if $order->{datereceived};
1582     my $basket = GetBasket($basketno);
1583     return unless $basket;
1584
1585     my $dbh = C4::Context->dbh;
1586     my ($query, $sth, $rv);
1587
1588     $query = qq{
1589         UPDATE aqorders
1590         SET datecancellationprinted = CAST(NOW() AS date)
1591         WHERE ordernumber = ?
1592     };
1593     $sth = $dbh->prepare($query);
1594     $rv = $sth->execute($ordernumber);
1595
1596     delete $order->{'ordernumber'};
1597     $order->{'basketno'} = $basketno;
1598     my $newordernumber;
1599     (undef, $newordernumber) = NewOrder($order);
1600
1601     $query = qq{
1602         UPDATE aqorders_items
1603         SET ordernumber = ?
1604         WHERE ordernumber = ?
1605     };
1606     $sth = $dbh->prepare($query);
1607     $sth->execute($newordernumber, $ordernumber);
1608
1609     $query = q{
1610         INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1611         VALUES (?, ?)
1612     };
1613     $sth = $dbh->prepare($query);
1614     $sth->execute($ordernumber, $newordernumber);
1615
1616     return $newordernumber;
1617 }
1618
1619 =head2 FUNCTIONS ABOUT PARCELS
1620
1621 =cut
1622
1623 #------------------------------------------------------------#
1624
1625 =head3 GetParcel
1626
1627   @results = &GetParcel($booksellerid, $code, $date);
1628
1629 Looks up all of the received items from the supplier with the given
1630 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1631
1632 C<@results> is an array of references-to-hash. The keys of each element are fields from
1633 the aqorders, biblio, and biblioitems tables of the Koha database.
1634
1635 C<@results> is sorted alphabetically by book title.
1636
1637 =cut
1638
1639 sub GetParcel {
1640     #gets all orders from a certain supplier, orders them alphabetically
1641     my ( $supplierid, $code, $datereceived ) = @_;
1642     my $dbh     = C4::Context->dbh;
1643     my @results = ();
1644     $code .= '%'
1645     if $code;  # add % if we search on a given code (otherwise, let him empty)
1646     my $strsth ="
1647         SELECT  authorisedby,
1648                 creationdate,
1649                 aqbasket.basketno,
1650                 closedate,surname,
1651                 firstname,
1652                 aqorders.biblionumber,
1653                 aqorders.ordernumber,
1654                 aqorders.parent_ordernumber,
1655                 aqorders.quantity,
1656                 aqorders.quantityreceived,
1657                 aqorders.unitprice,
1658                 aqorders.listprice,
1659                 aqorders.rrp,
1660                 aqorders.ecost,
1661                 aqorders.gstrate,
1662                 biblio.title
1663         FROM aqorders
1664         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1665         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1666         LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1667         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1668         WHERE
1669             aqbasket.booksellerid = ?
1670             AND aqinvoices.invoicenumber LIKE ?
1671             AND aqorders.datereceived = ? ";
1672
1673     my @query_params = ( $supplierid, $code, $datereceived );
1674     if ( C4::Context->preference("IndependentBranches") ) {
1675         my $userenv = C4::Context->userenv;
1676         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1677             $strsth .= " and (borrowers.branchcode = ?
1678                         or borrowers.branchcode  = '')";
1679             push @query_params, $userenv->{branch};
1680         }
1681     }
1682     $strsth .= " ORDER BY aqbasket.basketno";
1683     # ## parcelinformation : $strsth
1684     my $sth = $dbh->prepare($strsth);
1685     $sth->execute( @query_params );
1686     while ( my $data = $sth->fetchrow_hashref ) {
1687         push( @results, $data );
1688     }
1689     # ## countparcelbiblio: scalar(@results)
1690     $sth->finish;
1691
1692     return @results;
1693 }
1694
1695 #------------------------------------------------------------#
1696
1697 =head3 GetParcels
1698
1699   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1700
1701 get a lists of parcels.
1702
1703 * Input arg :
1704
1705 =over
1706
1707 =item $bookseller
1708 is the bookseller this function has to get parcels.
1709
1710 =item $order
1711 To know on what criteria the results list has to be ordered.
1712
1713 =item $code
1714 is the booksellerinvoicenumber.
1715
1716 =item $datefrom & $dateto
1717 to know on what date this function has to filter its search.
1718
1719 =back
1720
1721 * return:
1722 a pointer on a hash list containing parcel informations as such :
1723
1724 =over
1725
1726 =item Creation date
1727
1728 =item Last operation
1729
1730 =item Number of biblio
1731
1732 =item Number of items
1733
1734 =back
1735
1736 =cut
1737
1738 sub GetParcels {
1739     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1740     my $dbh    = C4::Context->dbh;
1741     my @query_params = ();
1742     my $strsth ="
1743         SELECT  aqinvoices.invoicenumber,
1744                 datereceived,purchaseordernumber,
1745                 count(DISTINCT biblionumber) AS biblio,
1746                 sum(quantity) AS itemsexpected,
1747                 sum(quantityreceived) AS itemsreceived
1748         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1749         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1750         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1751     ";
1752     push @query_params, $bookseller;
1753
1754     if ( defined $code ) {
1755         $strsth .= ' and aqinvoices.invoicenumber like ? ';
1756         # add a % to the end of the code to allow stemming.
1757         push @query_params, "$code%";
1758     }
1759
1760     if ( defined $datefrom ) {
1761         $strsth .= ' and datereceived >= ? ';
1762         push @query_params, $datefrom;
1763     }
1764
1765     if ( defined $dateto ) {
1766         $strsth .=  'and datereceived <= ? ';
1767         push @query_params, $dateto;
1768     }
1769
1770     $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
1771
1772     # can't use a placeholder to place this column name.
1773     # but, we could probably be checking to make sure it is a column that will be fetched.
1774     $strsth .= "order by $order " if ($order);
1775
1776     my $sth = $dbh->prepare($strsth);
1777
1778     $sth->execute( @query_params );
1779     my $results = $sth->fetchall_arrayref({});
1780     $sth->finish;
1781     return @$results;
1782 }
1783
1784 #------------------------------------------------------------#
1785
1786 =head3 GetLateOrders
1787
1788   @results = &GetLateOrders;
1789
1790 Searches for bookseller with late orders.
1791
1792 return:
1793 the table of supplier with late issues. This table is full of hashref.
1794
1795 =cut
1796
1797 sub GetLateOrders {
1798     my $delay      = shift;
1799     my $supplierid = shift;
1800     my $branch     = shift;
1801     my $estimateddeliverydatefrom = shift;
1802     my $estimateddeliverydateto = shift;
1803
1804     my $dbh = C4::Context->dbh;
1805
1806     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1807     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1808
1809     my @query_params = ();
1810     my $select = "
1811     SELECT aqbasket.basketno,
1812         aqorders.ordernumber,
1813         DATE(aqbasket.closedate)  AS orderdate,
1814         aqorders.rrp              AS unitpricesupplier,
1815         aqorders.ecost            AS unitpricelib,
1816         aqorders.claims_count     AS claims_count,
1817         aqorders.claimed_date     AS claimed_date,
1818         aqbudgets.budget_name     AS budget,
1819         borrowers.branchcode      AS branch,
1820         aqbooksellers.name        AS supplier,
1821         aqbooksellers.id          AS supplierid,
1822         biblio.author, biblio.title,
1823         biblioitems.publishercode AS publisher,
1824         biblioitems.publicationyear,
1825         ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1826     ";
1827     my $from = "
1828     FROM
1829         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
1830         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
1831         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
1832         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
1833         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
1834         WHERE aqorders.basketno = aqbasket.basketno
1835         AND ( datereceived = ''
1836             OR datereceived IS NULL
1837             OR aqorders.quantityreceived < aqorders.quantity
1838         )
1839         AND aqbasket.closedate IS NOT NULL
1840         AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1841     ";
1842     my $having = "";
1843     if ($dbdriver eq "mysql") {
1844         $select .= "
1845         aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity,
1846         (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1847         DATEDIFF(CAST(now() AS date),closedate) AS latesince
1848         ";
1849         if ( defined $delay ) {
1850             $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
1851             push @query_params, $delay;
1852         }
1853         $having = "
1854         HAVING quantity          <> 0
1855             AND unitpricesupplier <> 0
1856             AND unitpricelib      <> 0
1857         ";
1858     } else {
1859         # FIXME: account for IFNULL as above
1860         $select .= "
1861                 aqorders.quantity                AS quantity,
1862                 aqorders.quantity * aqorders.rrp AS subtotal,
1863                 (CAST(now() AS date) - closedate)            AS latesince
1864         ";
1865         if ( defined $delay ) {
1866             $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
1867             push @query_params, $delay;
1868         }
1869     }
1870     if (defined $supplierid) {
1871         $from .= ' AND aqbasket.booksellerid = ? ';
1872         push @query_params, $supplierid;
1873     }
1874     if (defined $branch) {
1875         $from .= ' AND borrowers.branchcode LIKE ? ';
1876         push @query_params, $branch;
1877     }
1878
1879     if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
1880         $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
1881     }
1882     if ( defined $estimateddeliverydatefrom ) {
1883         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
1884         push @query_params, $estimateddeliverydatefrom;
1885     }
1886     if ( defined $estimateddeliverydateto ) {
1887         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
1888         push @query_params, $estimateddeliverydateto;
1889     }
1890     if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
1891         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
1892     }
1893     if (C4::Context->preference("IndependentBranches")
1894             && C4::Context->userenv
1895             && C4::Context->userenv->{flags} != 1 ) {
1896         $from .= ' AND borrowers.branchcode LIKE ? ';
1897         push @query_params, C4::Context->userenv->{branch};
1898     }
1899     my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1900     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1901     my $sth = $dbh->prepare($query);
1902     $sth->execute(@query_params);
1903     my @results;
1904     while (my $data = $sth->fetchrow_hashref) {
1905         $data->{orderdate} = format_date($data->{orderdate});
1906         $data->{claimed_date} = format_date($data->{claimed_date});
1907         push @results, $data;
1908     }
1909     return @results;
1910 }
1911
1912 #------------------------------------------------------------#
1913
1914 =head3 GetHistory
1915
1916   (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( %params );
1917
1918 Retreives some acquisition history information
1919
1920 params:
1921   title
1922   author
1923   name
1924   from_placed_on
1925   to_placed_on
1926   basket                  - search both basket name and number
1927   booksellerinvoicenumber
1928
1929 returns:
1930     $order_loop is a list of hashrefs that each look like this:
1931             {
1932                 'author'           => 'Twain, Mark',
1933                 'basketno'         => '1',
1934                 'biblionumber'     => '215',
1935                 'count'            => 1,
1936                 'creationdate'     => 'MM/DD/YYYY',
1937                 'datereceived'     => undef,
1938                 'ecost'            => '1.00',
1939                 'id'               => '1',
1940                 'invoicenumber'    => undef,
1941                 'name'             => '',
1942                 'ordernumber'      => '1',
1943                 'quantity'         => 1,
1944                 'quantityreceived' => undef,
1945                 'title'            => 'The Adventures of Huckleberry Finn'
1946             }
1947     $total_qty is the sum of all of the quantities in $order_loop
1948     $total_price is the cost of each in $order_loop times the quantity
1949     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1950
1951 =cut
1952
1953 sub GetHistory {
1954 # don't run the query if there are no parameters (list would be too long for sure !)
1955     croak "No search params" unless @_;
1956     my %params = @_;
1957     my $title = $params{title};
1958     my $author = $params{author};
1959     my $isbn   = $params{isbn};
1960     my $ean    = $params{ean};
1961     my $name = $params{name};
1962     my $from_placed_on = $params{from_placed_on};
1963     my $to_placed_on = $params{to_placed_on};
1964     my $basket = $params{basket};
1965     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
1966     my $basketgroupname = $params{basketgroupname};
1967     my @order_loop;
1968     my $total_qty         = 0;
1969     my $total_qtyreceived = 0;
1970     my $total_price       = 0;
1971
1972     my $dbh   = C4::Context->dbh;
1973     my $query ="
1974         SELECT
1975             biblio.title,
1976             biblio.author,
1977             biblioitems.isbn,
1978         biblioitems.ean,
1979             aqorders.basketno,
1980             aqbasket.basketname,
1981             aqbasket.basketgroupid,
1982             aqbasketgroups.name as groupname,
1983             aqbooksellers.name,
1984             aqbasket.creationdate,
1985             aqorders.datereceived,
1986             aqorders.quantity,
1987             aqorders.quantityreceived,
1988             aqorders.ecost,
1989             aqorders.ordernumber,
1990             aqorders.invoiceid,
1991             aqinvoices.invoicenumber,
1992             aqbooksellers.id as id,
1993             aqorders.biblionumber
1994         FROM aqorders
1995         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1996         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
1997         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1998         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
1999         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2000     LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid";
2001
2002     $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
2003     if ( C4::Context->preference("IndependentBranches") );
2004
2005     $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2006
2007     my @query_params  = ();
2008
2009     if ( $title ) {
2010         $query .= " AND biblio.title LIKE ? ";
2011         $title =~ s/\s+/%/g;
2012         push @query_params, "%$title%";
2013     }
2014
2015     if ( $author ) {
2016         $query .= " AND biblio.author LIKE ? ";
2017         push @query_params, "%$author%";
2018     }
2019
2020     if ( $isbn ) {
2021         $query .= " AND biblioitems.isbn LIKE ? ";
2022         push @query_params, "%$isbn%";
2023     }
2024     if ( defined $ean and $ean ) {
2025         $query .= " AND biblioitems.ean = ? ";
2026         push @query_params, "$ean";
2027     }
2028     if ( $name ) {
2029         $query .= " AND aqbooksellers.name LIKE ? ";
2030         push @query_params, "%$name%";
2031     }
2032
2033     if ( $from_placed_on ) {
2034         $query .= " AND creationdate >= ? ";
2035         push @query_params, $from_placed_on;
2036     }
2037
2038     if ( $to_placed_on ) {
2039         $query .= " AND creationdate <= ? ";
2040         push @query_params, $to_placed_on;
2041     }
2042
2043     if ($basket) {
2044         if ($basket =~ m/^\d+$/) {
2045             $query .= " AND aqorders.basketno = ? ";
2046             push @query_params, $basket;
2047         } else {
2048             $query .= " AND aqbasket.basketname LIKE ? ";
2049             push @query_params, "%$basket%";
2050         }
2051     }
2052
2053     if ($booksellerinvoicenumber) {
2054         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2055         push @query_params, "%$booksellerinvoicenumber%";
2056     }
2057
2058     if ($basketgroupname) {
2059         $query .= " AND aqbasketgroups.name LIKE ? ";
2060         push @query_params, "%$basketgroupname%";
2061     }
2062
2063     if ( C4::Context->preference("IndependentBranches") ) {
2064         my $userenv = C4::Context->userenv;
2065         if ( $userenv && ($userenv->{flags} || 0) != 1 ) {
2066             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2067             push @query_params, $userenv->{branch};
2068         }
2069     }
2070     $query .= " ORDER BY id";
2071     my $sth = $dbh->prepare($query);
2072     $sth->execute( @query_params );
2073     my $cnt = 1;
2074     while ( my $line = $sth->fetchrow_hashref ) {
2075         $line->{count} = $cnt++;
2076         $line->{toggle} = 1 if $cnt % 2;
2077         push @order_loop, $line;
2078         $total_qty         += $line->{'quantity'};
2079         $total_qtyreceived += $line->{'quantityreceived'};
2080         $total_price       += $line->{'quantity'} * $line->{'ecost'};
2081     }
2082     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
2083 }
2084
2085 =head2 GetRecentAcqui
2086
2087   $results = GetRecentAcqui($days);
2088
2089 C<$results> is a ref to a table which containts hashref
2090
2091 =cut
2092
2093 sub GetRecentAcqui {
2094     my $limit  = shift;
2095     my $dbh    = C4::Context->dbh;
2096     my $query = "
2097         SELECT *
2098         FROM   biblio
2099         ORDER BY timestamp DESC
2100         LIMIT  0,".$limit;
2101
2102     my $sth = $dbh->prepare($query);
2103     $sth->execute;
2104     my $results = $sth->fetchall_arrayref({});
2105     return $results;
2106 }
2107
2108 =head3 GetContracts
2109
2110   $contractlist = &GetContracts($booksellerid, $activeonly);
2111
2112 Looks up the contracts that belong to a bookseller
2113
2114 Returns a list of contracts
2115
2116 =over
2117
2118 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
2119
2120 =item C<$activeonly> if exists get only contracts that are still active.
2121
2122 =back
2123
2124 =cut
2125
2126 sub GetContracts {
2127     my ( $booksellerid, $activeonly ) = @_;
2128     my $dbh = C4::Context->dbh;
2129     my $query;
2130     if (! $activeonly) {
2131         $query = "
2132             SELECT *
2133             FROM   aqcontract
2134             WHERE  booksellerid=?
2135         ";
2136     } else {
2137         $query = "SELECT *
2138             FROM aqcontract
2139             WHERE booksellerid=?
2140                 AND contractenddate >= CURDATE( )";
2141     }
2142     my $sth = $dbh->prepare($query);
2143     $sth->execute( $booksellerid );
2144     my @results;
2145     while (my $data = $sth->fetchrow_hashref ) {
2146         push(@results, $data);
2147     }
2148     $sth->finish;
2149     return @results;
2150 }
2151
2152 #------------------------------------------------------------#
2153
2154 =head3 GetContract
2155
2156   $contract = &GetContract($contractID);
2157
2158 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
2159
2160 Returns a contract
2161
2162 =cut
2163
2164 sub GetContract {
2165     my ( $contractno ) = @_;
2166     my $dbh = C4::Context->dbh;
2167     my $query = "
2168         SELECT *
2169         FROM   aqcontract
2170         WHERE  contractnumber=?
2171         ";
2172
2173     my $sth = $dbh->prepare($query);
2174     $sth->execute( $contractno );
2175     my $result = $sth->fetchrow_hashref;
2176     return $result;
2177 }
2178
2179 =head3 AddClaim
2180
2181 =over 4
2182
2183 &AddClaim($ordernumber);
2184
2185 Add a claim for an order
2186
2187 =back
2188
2189 =cut
2190 sub AddClaim {
2191     my ($ordernumber) = @_;
2192     my $dbh          = C4::Context->dbh;
2193     my $query        = "
2194         UPDATE aqorders SET
2195             claims_count = claims_count + 1,
2196             claimed_date = CURDATE()
2197         WHERE ordernumber = ?
2198         ";
2199     my $sth = $dbh->prepare($query);
2200     $sth->execute($ordernumber);
2201 }
2202
2203 =head3 GetInvoices
2204
2205     my @invoices = GetInvoices(
2206         invoicenumber => $invoicenumber,
2207         suppliername => $suppliername,
2208         shipmentdatefrom => $shipmentdatefrom, # ISO format
2209         shipmentdateto => $shipmentdateto, # ISO format
2210         billingdatefrom => $billingdatefrom, # ISO format
2211         billingdateto => $billingdateto, # ISO format
2212         isbneanissn => $isbn_or_ean_or_issn,
2213         title => $title,
2214         author => $author,
2215         publisher => $publisher,
2216         publicationyear => $publicationyear,
2217         branchcode => $branchcode,
2218         order_by => $order_by
2219     );
2220
2221 Return a list of invoices that match all given criteria.
2222
2223 $order_by is "column_name (asc|desc)", where column_name is any of
2224 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2225 'shipmentcost', 'shipmentcost_budgetid'.
2226
2227 asc is the default if omitted
2228
2229 =cut
2230
2231 sub GetInvoices {
2232     my %args = @_;
2233
2234     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2235         closedate shipmentcost shipmentcost_budgetid);
2236
2237     my $dbh = C4::Context->dbh;
2238     my $query = qq{
2239         SELECT aqinvoices.*, aqbooksellers.name AS suppliername,
2240           COUNT(
2241             DISTINCT IF(
2242               aqorders.datereceived IS NOT NULL,
2243               aqorders.biblionumber,
2244               NULL
2245             )
2246           ) AS receivedbiblios,
2247           SUM(aqorders.quantityreceived) AS receiveditems
2248         FROM aqinvoices
2249           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2250           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2251           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2252           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2253           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2254     };
2255
2256     my @bind_args;
2257     my @bind_strs;
2258     if($args{supplierid}) {
2259         push @bind_strs, " aqinvoices.booksellerid = ? ";
2260         push @bind_args, $args{supplierid};
2261     }
2262     if($args{invoicenumber}) {
2263         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2264         push @bind_args, "%$args{invoicenumber}%";
2265     }
2266     if($args{suppliername}) {
2267         push @bind_strs, " aqbooksellers.name LIKE ? ";
2268         push @bind_args, "%$args{suppliername}%";
2269     }
2270     if($args{shipmentdatefrom}) {
2271         push @bind_strs, " aqinvoices.shipementdate >= ? ";
2272         push @bind_args, $args{shipmentdatefrom};
2273     }
2274     if($args{shipmentdateto}) {
2275         push @bind_strs, " aqinvoices.shipementdate <= ? ";
2276         push @bind_args, $args{shipmentdateto};
2277     }
2278     if($args{billingdatefrom}) {
2279         push @bind_strs, " aqinvoices.billingdate >= ? ";
2280         push @bind_args, $args{billingdatefrom};
2281     }
2282     if($args{billingdateto}) {
2283         push @bind_strs, " aqinvoices.billingdate <= ? ";
2284         push @bind_args, $args{billingdateto};
2285     }
2286     if($args{isbneanissn}) {
2287         push @bind_strs, " (biblioitems.isbn LIKE ? OR biblioitems.ean LIKE ? OR biblioitems.issn LIKE ? ) ";
2288         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2289     }
2290     if($args{title}) {
2291         push @bind_strs, " biblio.title LIKE ? ";
2292         push @bind_args, $args{title};
2293     }
2294     if($args{author}) {
2295         push @bind_strs, " biblio.author LIKE ? ";
2296         push @bind_args, $args{author};
2297     }
2298     if($args{publisher}) {
2299         push @bind_strs, " biblioitems.publishercode LIKE ? ";
2300         push @bind_args, $args{publisher};
2301     }
2302     if($args{publicationyear}) {
2303         push @bind_strs, " biblioitems.publicationyear = ? ";
2304         push @bind_args, $args{publicationyear};
2305     }
2306     if($args{branchcode}) {
2307         push @bind_strs, " aqorders.branchcode = ? ";
2308         push @bind_args, $args{branchcode};
2309     }
2310
2311     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2312     $query .= " GROUP BY aqinvoices.invoiceid ";
2313
2314     if($args{order_by}) {
2315         my ($column, $direction) = split / /, $args{order_by};
2316         if(grep /^$column$/, @columns) {
2317             $direction ||= 'ASC';
2318             $query .= " ORDER BY $column $direction";
2319         }
2320     }
2321
2322     my $sth = $dbh->prepare($query);
2323     $sth->execute(@bind_args);
2324
2325     my $results = $sth->fetchall_arrayref({});
2326     return @$results;
2327 }
2328
2329 =head3 GetInvoice
2330
2331     my $invoice = GetInvoice($invoiceid);
2332
2333 Get informations about invoice with given $invoiceid
2334
2335 Return a hash filled with aqinvoices.* fields
2336
2337 =cut
2338
2339 sub GetInvoice {
2340     my ($invoiceid) = @_;
2341     my $invoice;
2342
2343     return unless $invoiceid;
2344
2345     my $dbh = C4::Context->dbh;
2346     my $query = qq{
2347         SELECT *
2348         FROM aqinvoices
2349         WHERE invoiceid = ?
2350     };
2351     my $sth = $dbh->prepare($query);
2352     $sth->execute($invoiceid);
2353
2354     $invoice = $sth->fetchrow_hashref;
2355     return $invoice;
2356 }
2357
2358 =head3 GetInvoiceDetails
2359
2360     my $invoice = GetInvoiceDetails($invoiceid)
2361
2362 Return informations about an invoice + the list of related order lines
2363
2364 Orders informations are in $invoice->{orders} (array ref)
2365
2366 =cut
2367
2368 sub GetInvoiceDetails {
2369     my ($invoiceid) = @_;
2370
2371     if ( !defined $invoiceid ) {
2372         carp 'GetInvoiceDetails called without an invoiceid';
2373         return;
2374     }
2375
2376     my $dbh = C4::Context->dbh;
2377     my $query = qq{
2378         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2379         FROM aqinvoices
2380           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2381         WHERE invoiceid = ?
2382     };
2383     my $sth = $dbh->prepare($query);
2384     $sth->execute($invoiceid);
2385
2386     my $invoice = $sth->fetchrow_hashref;
2387
2388     $query = qq{
2389         SELECT aqorders.*, biblio.*,
2390         aqbasket.basketname
2391         FROM aqorders
2392           LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2393           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2394         WHERE invoiceid = ?
2395     };
2396     $sth = $dbh->prepare($query);
2397     $sth->execute($invoiceid);
2398     $invoice->{orders} = $sth->fetchall_arrayref({});
2399     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2400
2401     return $invoice;
2402 }
2403
2404 =head3 AddInvoice
2405
2406     my $invoiceid = AddInvoice(
2407         invoicenumber => $invoicenumber,
2408         booksellerid => $booksellerid,
2409         shipmentdate => $shipmentdate,
2410         billingdate => $billingdate,
2411         closedate => $closedate,
2412         shipmentcost => $shipmentcost,
2413         shipmentcost_budgetid => $shipmentcost_budgetid
2414     );
2415
2416 Create a new invoice and return its id or undef if it fails.
2417
2418 =cut
2419
2420 sub AddInvoice {
2421     my %invoice = @_;
2422
2423     return unless(%invoice and $invoice{invoicenumber});
2424
2425     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2426         closedate shipmentcost shipmentcost_budgetid);
2427
2428     my @set_strs;
2429     my @set_args;
2430     foreach my $key (keys %invoice) {
2431         if(0 < grep(/^$key$/, @columns)) {
2432             push @set_strs, "$key = ?";
2433             push @set_args, ($invoice{$key} || undef);
2434         }
2435     }
2436
2437     my $rv;
2438     if(@set_args > 0) {
2439         my $dbh = C4::Context->dbh;
2440         my $query = "INSERT INTO aqinvoices SET ";
2441         $query .= join (",", @set_strs);
2442         my $sth = $dbh->prepare($query);
2443         $rv = $sth->execute(@set_args);
2444         if($rv) {
2445             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2446         }
2447     }
2448     return $rv;
2449 }
2450
2451 =head3 ModInvoice
2452
2453     ModInvoice(
2454         invoiceid => $invoiceid,    # Mandatory
2455         invoicenumber => $invoicenumber,
2456         booksellerid => $booksellerid,
2457         shipmentdate => $shipmentdate,
2458         billingdate => $billingdate,
2459         closedate => $closedate,
2460         shipmentcost => $shipmentcost,
2461         shipmentcost_budgetid => $shipmentcost_budgetid
2462     );
2463
2464 Modify an invoice, invoiceid is mandatory.
2465
2466 Return undef if it fails.
2467
2468 =cut
2469
2470 sub ModInvoice {
2471     my %invoice = @_;
2472
2473     return unless(%invoice and $invoice{invoiceid});
2474
2475     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2476         closedate shipmentcost shipmentcost_budgetid);
2477
2478     my @set_strs;
2479     my @set_args;
2480     foreach my $key (keys %invoice) {
2481         if(0 < grep(/^$key$/, @columns)) {
2482             push @set_strs, "$key = ?";
2483             push @set_args, ($invoice{$key} || undef);
2484         }
2485     }
2486
2487     my $dbh = C4::Context->dbh;
2488     my $query = "UPDATE aqinvoices SET ";
2489     $query .= join(",", @set_strs);
2490     $query .= " WHERE invoiceid = ?";
2491
2492     my $sth = $dbh->prepare($query);
2493     $sth->execute(@set_args, $invoice{invoiceid});
2494 }
2495
2496 =head3 CloseInvoice
2497
2498     CloseInvoice($invoiceid);
2499
2500 Close an invoice.
2501
2502 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2503
2504 =cut
2505
2506 sub CloseInvoice {
2507     my ($invoiceid) = @_;
2508
2509     return unless $invoiceid;
2510
2511     my $dbh = C4::Context->dbh;
2512     my $query = qq{
2513         UPDATE aqinvoices
2514         SET closedate = CAST(NOW() AS DATE)
2515         WHERE invoiceid = ?
2516     };
2517     my $sth = $dbh->prepare($query);
2518     $sth->execute($invoiceid);
2519 }
2520
2521 =head3 ReopenInvoice
2522
2523     ReopenInvoice($invoiceid);
2524
2525 Reopen an invoice
2526
2527 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => C4::Dates->new()->output('iso'))
2528
2529 =cut
2530
2531 sub ReopenInvoice {
2532     my ($invoiceid) = @_;
2533
2534     return unless $invoiceid;
2535
2536     my $dbh = C4::Context->dbh;
2537     my $query = qq{
2538         UPDATE aqinvoices
2539         SET closedate = NULL
2540         WHERE invoiceid = ?
2541     };
2542     my $sth = $dbh->prepare($query);
2543     $sth->execute($invoiceid);
2544 }
2545
2546 =head3 DelInvoice
2547
2548     DelInvoice($invoiceid);
2549
2550 Delete an invoice if there are no items attached to it.
2551
2552 =cut
2553
2554 sub DelInvoice {
2555     my ($invoiceid) = @_;
2556
2557     return unless $invoiceid;
2558
2559     my $dbh   = C4::Context->dbh;
2560     my $query = qq{
2561         SELECT COUNT(*)
2562         FROM aqorders
2563         WHERE invoiceid = ?
2564     };
2565     my $sth = $dbh->prepare($query);
2566     $sth->execute($invoiceid);
2567     my $res = $sth->fetchrow_arrayref;
2568     if ( $res && $res->[0] == 0 ) {
2569         $query = qq{
2570             DELETE FROM aqinvoices
2571             WHERE invoiceid = ?
2572         };
2573         my $sth = $dbh->prepare($query);
2574         return ( $sth->execute($invoiceid) > 0 );
2575     }
2576     return;
2577 }
2578
2579 =head3 MergeInvoices
2580
2581     MergeInvoices($invoiceid, \@sourceids);
2582
2583 Merge the invoices identified by the IDs in \@sourceids into
2584 the invoice identified by $invoiceid.
2585
2586 =cut
2587
2588 sub MergeInvoices {
2589     my ($invoiceid, $sourceids) = @_;
2590
2591     return unless $invoiceid;
2592     foreach my $sourceid (@$sourceids) {
2593         next if $sourceid == $invoiceid;
2594         my $source = GetInvoiceDetails($sourceid);
2595         foreach my $order (@{$source->{'orders'}}) {
2596             $order->{'invoiceid'} = $invoiceid;
2597             ModOrder($order);
2598         }
2599         DelInvoice($source->{'invoiceid'});
2600     }
2601     return;
2602 }
2603
2604 1;
2605 __END__
2606
2607 =head1 AUTHOR
2608
2609 Koha Development Team <http://koha-community.org/>
2610
2611 =cut