C4/Acquisition.pm

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