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