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