C4/Acquisition.pm

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