File Coverage

File:C4/Acquisition.pm
Coverage:7.6%

linestmtbrancondsubtimecode
1package C4::Acquisition;
2
3# Copyright 2000-2002 Katipo Communications
4#
5# This file is part of Koha.
6#
7# Koha is free software; you can redistribute it and/or modify it under the
8# terms of the GNU General Public License as published by the Free Software
9# Foundation; either version 2 of the License, or (at your option) any later
10# version.
11#
12# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License along
17# with Koha; if not, write to the Free Software Foundation, Inc.,
18# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
21
2
2
2
1486
29
92
use strict;
22
2
2
2
15
9
99
use warnings;
23
2
2
2
14
7
149
use Carp;
24
2
2
2
14
7
26
use C4::Context;
25
2
2
2
8
4
192
use C4::Debug;
26
2
2
2
22
2
95
use C4::Dates qw(format_date format_date_in_iso);
27
2
2
2
10
3
87
use MARC::Record;
28
2
2
2
208
24
444
use C4::Suggestions;
29
2
2
2
11
2
1033
use C4::Biblio;
30
2
2
2
9
3
153
use C4::Debug;
31
2
2
2
9
34
122
use C4::SQLHelper qw(InsertInTable);
32
33
2
2
2
40108
32011
138
use Time::localtime;
34
2
2
2
30491
14906
396
use HTML::Entities;
35
36
2
2
2
11
3
261
use vars qw($VERSION @ISA @EXPORT);
37
38BEGIN {
39    # set the version for version checking
40
2
5
    $VERSION = 3.01;
41
2
8
    require Exporter;
42
2
21
    @ISA = qw(Exporter);
43
2
12411
    @EXPORT = qw(
44        &GetBasket &NewBasket &CloseBasket &DelBasket &ModBasket
45        &GetBasketAsCSV
46        &GetBasketsByBookseller &GetBasketsByBasketgroup
47
48        &ModBasketHeader
49
50        &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup
51        &GetBasketgroups &ReOpenBasketgroup
52
53        &NewOrder &DelOrder &ModOrder &GetPendingOrders &GetOrder &GetOrders
54        &GetOrderNumber &GetLateOrders &GetOrderFromItemnumber
55        &SearchOrder &GetHistory &GetRecentAcqui
56        &ModReceiveOrder &ModOrderBiblioitemNumber
57        &GetCancelledOrders
58
59        &NewOrderItem &ModOrderItem
60
61        &GetParcels &GetParcel
62        &GetContracts &GetContract
63
64        &GetItemnumbersFromOrder
65
66        &AddClaim
67    );
68}
69
70
71
72
73
74sub GetOrderFromItemnumber {
75
0
    my ($itemnumber) = @_;
76
0
    my $dbh = C4::Context->dbh;
77
0
    my $query = qq|
78
79    SELECT * from aqorders LEFT JOIN aqorders_items
80    ON ( aqorders.ordernumber = aqorders_items.ordernumber )
81    WHERE itemnumber = ? |;
82
83
0
    my $sth = $dbh->prepare($query);
84
85# $sth->trace(3);
86
87
0
    $sth->execute($itemnumber);
88
89
0
    my $order = $sth->fetchrow_hashref;
90
0
    return ( $order );
91
92}
93
94# Returns the itemnumber(s) associated with the ordernumber given in parameter
95sub GetItemnumbersFromOrder {
96
0
    my ($ordernumber) = @_;
97
0
    my $dbh = C4::Context->dbh;
98
0
    my $query = "SELECT itemnumber FROM aqorders_items WHERE ordernumber=?";
99
0
    my $sth = $dbh->prepare($query);
100
0
    $sth->execute($ordernumber);
101
0
    my @tab;
102
103
0
    while (my $order = $sth->fetchrow_hashref) {
104
0
    push @tab, $order->{'itemnumber'};
105    }
106
107
0
    return @tab;
108
109}
110
111
112
113
114
115
116 - 141
=head1 NAME

C4::Acquisition - Koha functions for dealing with orders and acquisitions

=head1 SYNOPSIS

use C4::Acquisition;

=head1 DESCRIPTION

The functions in this module deal with acquisitions, managing book
orders, basket and parcels.

=head1 FUNCTIONS

=head2 FUNCTIONS ABOUT BASKETS

=head3 GetBasket

  $aqbasket = &GetBasket($basketnumber);

get all basket informations in aqbasket for a given basket

B<returns:> informations for a given basket returned as a hashref.

=cut
142
143sub GetBasket {
144
0
    my ($basketno) = @_;
145
0
    my $dbh = C4::Context->dbh;
146
0
    my $query = "
147        SELECT aqbasket.*,
148                concat( b.firstname,' ',b.surname) AS authorisedbyname,
149                b.branchcode AS branch
150        FROM aqbasket
151        LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
152        WHERE basketno=?
153    ";
154
0
    my $sth=$dbh->prepare($query);
155
0
    $sth->execute($basketno);
156
0
    my $basket = $sth->fetchrow_hashref;
157
0
    return ( $basket );
158}
159
160#------------------------------------------------------------#
161
162 - 179
=head3 NewBasket

  $basket = &NewBasket( $booksellerid, $authorizedby, $basketname, 
      $basketnote, $basketbooksellernote, $basketcontractnumber );

Create a new basket in aqbasket table

=over

=item C<$booksellerid> is a foreign key in the aqbasket table

=item C<$authorizedby> is the username of who created the basket

=back

The other parameters are optional, see ModBasketHeader for more info on them.

=cut
180
181# FIXME : this function seems to be unused.
182
183sub NewBasket {
184
0
    my ( $booksellerid, $authorisedby, $basketname, $basketnote, $basketbooksellernote, $basketcontractnumber ) = @_;
185
0
    my $dbh = C4::Context->dbh;
186
0
    my $query = "
187        INSERT INTO aqbasket
188                (creationdate,booksellerid,authorisedby)
189        VALUES (now(),'$booksellerid','$authorisedby')
190    ";
191
0
    my $sth =
192    $dbh->do($query);
193#find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
194
0
    my $basket = $dbh->{'mysql_insertid'};
195
0
    ModBasketHeader($basket, $basketname || '', $basketnote || '', $basketbooksellernote || '', $basketcontractnumber || undef);
196
0
    return $basket;
197}
198
199#------------------------------------------------------------#
200
201 - 207
=head3 CloseBasket

  &CloseBasket($basketno);

close a basket (becomes unmodifiable,except for recieves)

=cut
208
209sub CloseBasket {
210
0
    my ($basketno) = @_;
211
0
    my $dbh = C4::Context->dbh;
212
0
    my $query = "
213        UPDATE aqbasket
214        SET closedate=now()
215        WHERE basketno=?
216    ";
217
0
    my $sth = $dbh->prepare($query);
218
0
    $sth->execute($basketno);
219}
220
221#------------------------------------------------------------#
222
223 - 229
=head3 GetBasketAsCSV

  &GetBasketAsCSV($basketno);

Export a basket as CSV

=cut
230
231sub GetBasketAsCSV {
232
0
    my ($basketno) = @_;
233
0
    my $basket = GetBasket($basketno);
234
0
    my @orders = GetOrders($basketno);
235
0
    my $contract = GetContract($basket->{'contractnumber'});
236
0
    my $csv = Text::CSV->new();
237
0
    my $output;
238
239    # TODO: Translate headers
240
0
    my @headers = qw(contractname ordernumber entrydate isbn author title publishercode collectiontitle notes quantity rrp);
241
242
0
    $csv->combine(@headers);
243
0
    $output = $csv->string() . "\n";
244
245
0
    my @rows;
246
0
    foreach my $order (@orders) {
247
0
        my @cols;
248        # newlines are not valid characters for Text::CSV combine()
249
0
        $order->{'notes'} =~ s/[\r\n]+//g;
250
0
        push(@cols,
251                $contract->{'contractname'},
252                $order->{'ordernumber'},
253                $order->{'entrydate'},
254                $order->{'isbn'},
255                $order->{'author'},
256                $order->{'title'},
257                $order->{'publishercode'},
258                $order->{'collectiontitle'},
259                $order->{'notes'},
260                $order->{'quantity'},
261                $order->{'rrp'},
262            );
263
0
        push (@rows, \@cols);
264    }
265
266
0
    foreach my $row (@rows) {
267
0
        $csv->combine(@$row);
268
0
        $output .= $csv->string() . "\n";
269
270    }
271
272
0
    return $output;
273
274}
275
276
277 - 283
=head3 CloseBasketgroup

  &CloseBasketgroup($basketgroupno);

close a basketgroup

=cut
284
285sub CloseBasketgroup {
286
0
    my ($basketgroupno) = @_;
287
0
    my $dbh = C4::Context->dbh;
288
0
    my $sth = $dbh->prepare("
289        UPDATE aqbasketgroups
290        SET closed=1
291        WHERE id=?
292    ");
293
0
    $sth->execute($basketgroupno);
294}
295
296#------------------------------------------------------------#
297
298 - 304
=head3 ReOpenBaskergroup($basketgroupno)

  &ReOpenBaskergroup($basketgroupno);

reopen a basketgroup

=cut
305
306sub ReOpenBasketgroup {
307
0
    my ($basketgroupno) = @_;
308
0
    my $dbh = C4::Context->dbh;
309
0
    my $sth = $dbh->prepare("
310        UPDATE aqbasketgroups
311        SET closed=0
312        WHERE id=?
313    ");
314
0
    $sth->execute($basketgroupno);
315}
316
317#------------------------------------------------------------#
318
319
320 - 332
=head3 DelBasket

  &DelBasket($basketno);

Deletes the basket that has basketno field $basketno in the aqbasket table.

=over

=item C<$basketno> is the primary key of the basket in the aqbasket table.

=back

=cut
333
334sub DelBasket {
335
0
    my ( $basketno ) = @_;
336
0
    my $query = "DELETE FROM aqbasket WHERE basketno=?";
337
0
    my $dbh = C4::Context->dbh;
338
0
    my $sth = $dbh->prepare($query);
339
0
    $sth->execute($basketno);
340
0
    $sth->finish;
341}
342
343#------------------------------------------------------------#
344
345 - 357
=head3 ModBasket

  &ModBasket($basketinfo);

Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.

=over

=item C<$basketno> is the primary key of the basket in the aqbasket table.

=back

=cut
358
359sub ModBasket {
360
0
    my $basketinfo = shift;
361
0
    my $query = "UPDATE aqbasket SET ";
362
0
    my @params;
363
0
    foreach my $key (keys %$basketinfo){
364
0
        if ($key ne 'basketno'){
365
0
            $query .= "$key=?, ";
366
0
            push(@params, $basketinfo->{$key} || undef );
367        }
368    }
369# get rid of the "," at the end of $query
370
0
    if (substr($query, length($query)-2) eq ', '){
371
0
        chop($query);
372
0
        chop($query);
373
0
        $query .= ' ';
374    }
375
0
    $query .= "WHERE basketno=?";
376
0
    push(@params, $basketinfo->{'basketno'});
377
0
    my $dbh = C4::Context->dbh;
378
0
    my $sth = $dbh->prepare($query);
379
0
    $sth->execute(@params);
380
0
    $sth->finish;
381}
382
383#------------------------------------------------------------#
384
385 - 405
=head3 ModBasketHeader

  &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber);

Modifies a basket's header.

=over

=item C<$basketno> is the "basketno" field in the "aqbasket" table;

=item C<$basketname> is the "basketname" field in the "aqbasket" table;

=item C<$note> is the "note" field in the "aqbasket" table;

=item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;

=item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.

=back

=cut
406
407sub ModBasketHeader {
408
0
    my ($basketno, $basketname, $note, $booksellernote, $contractnumber) = @_;
409
0
    my $query = "UPDATE aqbasket SET basketname=?, note=?, booksellernote=? WHERE basketno=?";
410
0
    my $dbh = C4::Context->dbh;
411
0
    my $sth = $dbh->prepare($query);
412
0
    $sth->execute($basketname,$note,$booksellernote,$basketno);
413
0
    if ( $contractnumber ) {
414
0
        my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
415
0
        my $sth2 = $dbh->prepare($query2);
416
0
        $sth2->execute($contractnumber,$basketno);
417
0
        $sth2->finish;
418    }
419
0
    $sth->finish;
420}
421
422#------------------------------------------------------------#
423
424 - 443
=head3 GetBasketsByBookseller

  @results = &GetBasketsByBookseller($booksellerid, $extra);

Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.

=over

=item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table

=item C<$extra> is the extra sql parameters, can be

 $extra->{groupby}: group baskets by column
    ex. $extra->{groupby} = aqbasket.basketgroupid
 $extra->{orderby}: order baskets by column
 $extra->{limit}: limit number of results (can be helpful for pagination)

=back

=cut
444
445sub GetBasketsByBookseller {
446
0
    my ($booksellerid, $extra) = @_;
447
0
    my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
448
0
    if ($extra){
449
0
        if ($extra->{groupby}) {
450
0
            $query .= " GROUP by $extra->{groupby}";
451        }
452
0
        if ($extra->{orderby}){
453
0
            $query .= " ORDER by $extra->{orderby}";
454        }
455
0
        if ($extra->{limit}){
456
0
            $query .= " LIMIT $extra->{limit}";
457        }
458    }
459
0
    my $dbh = C4::Context->dbh;
460
0
    my $sth = $dbh->prepare($query);
461
0
    $sth->execute($booksellerid);
462
0
    my $results = $sth->fetchall_arrayref({});
463
0
    $sth->finish;
464
0
    return $results
465}
466
467#------------------------------------------------------------#
468
469 - 475
=head3 GetBasketsByBasketgroup

  $baskets = &GetBasketsByBasketgroup($basketgroupid);

Returns a reference to all baskets that belong to basketgroup $basketgroupid.

=cut
476
477sub GetBasketsByBasketgroup {
478
0
    my $basketgroupid = shift;
479
0
    my $query = "SELECT * FROM aqbasket
480                LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?";
481
0
    my $dbh = C4::Context->dbh;
482
0
    my $sth = $dbh->prepare($query);
483
0
    $sth->execute($basketgroupid);
484
0
    my $results = $sth->fetchall_arrayref({});
485
0
    $sth->finish;
486
0
    return $results
487}
488
489#------------------------------------------------------------#
490
491 - 509
=head3 NewBasketgroup

  $basketgroupid = NewBasketgroup(\%hashref);

Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.

$hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,

$hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,

$hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,

$hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,

$hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,

$hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.

=cut
510
511sub NewBasketgroup {
512
0
    my $basketgroupinfo = shift;
513
0
    die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
514
0
    my $query = "INSERT INTO aqbasketgroups (";
515
0
    my @params;
516
0
    foreach my $field ('name', 'deliveryplace', 'deliverycomment', 'closed') {
517
0
        if ( $basketgroupinfo->{$field} ) {
518
0
            $query .= "$field, ";
519
0
            push(@params, $basketgroupinfo->{$field});
520        }
521    }
522
0
    $query .= "booksellerid) VALUES (";
523
0
    foreach (@params) {
524
0
        $query .= "?, ";
525    }
526
0
    $query .= "?)";
527
0
    push(@params, $basketgroupinfo->{'booksellerid'});
528
0
    my $dbh = C4::Context->dbh;
529
0
    my $sth = $dbh->prepare($query);
530
0
    $sth->execute(@params);
531
0
    my $basketgroupid = $dbh->{'mysql_insertid'};
532
0
    if( $basketgroupinfo->{'basketlist'} ) {
533
0
0
        foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
534
0
            my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
535
0
            my $sth2 = $dbh->prepare($query2);
536
0
            $sth2->execute($basketgroupid, $basketno);
537        }
538    }
539
0
    return $basketgroupid;
540}
541
542#------------------------------------------------------------#
543
544 - 564
=head3 ModBasketgroup

  ModBasketgroup(\%hashref);

Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.

$hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,

$hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,

$hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,

$hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,

$hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,

$hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,

$hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.

=cut
565
566sub ModBasketgroup {
567
0
    my $basketgroupinfo = shift;
568
0
    die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
569
0
    my $dbh = C4::Context->dbh;
570
0
    my $query = "UPDATE aqbasketgroups SET ";
571
0
    my @params;
572
0
    foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
573
0
        if ( defined $basketgroupinfo->{$field} ) {
574
0
            $query .= "$field=?, ";
575
0
            push(@params, $basketgroupinfo->{$field});
576        }
577    }
578
0
    chop($query);
579
0
    chop($query);
580
0
    $query .= " WHERE id=?";
581
0
    push(@params, $basketgroupinfo->{'id'});
582
0
    my $sth = $dbh->prepare($query);
583
0
    $sth->execute(@params);
584
585
0
    $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
586
0
    $sth->execute($basketgroupinfo->{'id'});
587
588
0
0
    if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
589
0
        $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
590
0
0
        foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
591
0
            $sth->execute($basketgroupinfo->{'id'}, $basketno);
592
0
            $sth->finish;
593        }
594    }
595
0
    $sth->finish;
596}
597
598#------------------------------------------------------------#
599
600 - 612
=head3 DelBasketgroup

  DelBasketgroup($basketgroupid);

Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,

=over

=item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table

=back

=cut
613
614sub DelBasketgroup {
615
0
    my $basketgroupid = shift;
616
0
    die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
617
0
    my $query = "DELETE FROM aqbasketgroups WHERE id=?";
618
0
    my $dbh = C4::Context->dbh;
619
0
    my $sth = $dbh->prepare($query);
620
0
    $sth->execute($basketgroupid);
621
0
    $sth->finish;
622}
623
624#------------------------------------------------------------#
625
626
627 - 635
=head2 FUNCTIONS ABOUT ORDERS

=head3 GetBasketgroup

  $basketgroup = &GetBasketgroup($basketgroupid);

Returns a reference to the hash containing all infermation about the basketgroup.

=cut
636
637sub GetBasketgroup {
638
0
    my $basketgroupid = shift;
639
0
    die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
640
0
    my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
641
0
    my $dbh = C4::Context->dbh;
642
0
    my $sth = $dbh->prepare($query);
643
0
    $sth->execute($basketgroupid);
644
0
    my $result = $sth->fetchrow_hashref;
645
0
    $sth->finish;
646
0
    return $result
647}
648
649#------------------------------------------------------------#
650
651 - 657
=head3 GetBasketgroups

  $basketgroups = &GetBasketgroups($booksellerid);

Returns a reference to the array of all the basketgroups of bookseller $booksellerid.

=cut
658
659sub GetBasketgroups {
660
0
    my $booksellerid = shift;
661
0
    die "bookseller id is required to edit a basketgroup" unless $booksellerid;
662
0
    my $query = "SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY `id` DESC";
663
0
    my $dbh = C4::Context->dbh;
664
0
    my $sth = $dbh->prepare($query);
665
0
    $sth->execute($booksellerid);
666
0
    my $results = $sth->fetchall_arrayref({});
667
0
    $sth->finish;
668
0
    return $results
669}
670
671#------------------------------------------------------------#
672
673 - 675
=head2 FUNCTIONS ABOUT ORDERS

=cut
676
677#------------------------------------------------------------#
678
679 - 710
=head3 GetPendingOrders

  $orders = &GetPendingOrders($booksellerid, $grouped, $owner);

Finds pending orders from the bookseller with the given ID. Ignores
completed and cancelled orders.

C<$booksellerid> contains the bookseller identifier
C<$grouped> contains 0 or 1. 0 means returns the list, 1 means return the total
C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.

C<$orders> is a reference-to-array; each element is a
reference-to-hash with the following fields:
C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
in a single result line

=over

=item C<authorizedby>

=item C<entrydate>

=item C<basketno>

=back

These give the value of the corresponding field in the aqorders table
of the Koha database.

Results are ordered from most to least recent.

=cut
711
712sub GetPendingOrders {
713
0
    my ($supplierid,$grouped,$owner,$basketno) = @_;
714
0
    my $dbh = C4::Context->dbh;
715
0
    my $strsth = "
716        SELECT ".($grouped?"count(*),":"")."aqbasket.basketno,
717                    surname,firstname,aqorders.*,biblio.*,biblioitems.isbn,
718                    aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname
719        FROM aqorders
720        LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
721        LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
722        LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
723        LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
724        WHERE booksellerid=?
725            AND (quantity > quantityreceived OR quantityreceived is NULL)
726            AND datecancellationprinted IS NULL";
727
0
    my @query_params = ( $supplierid );
728
0
    my $userenv = C4::Context->userenv;
729
0
    if ( C4::Context->preference("IndependantBranches") ) {
730
0
        if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
731
0
            $strsth .= " and (borrowers.branchcode = ?
732                        or borrowers.branchcode = '')";
733
0
            push @query_params, $userenv->{branch};
734        }
735    }
736
0
    if ($owner) {
737
0
        $strsth .= " AND aqbasket.authorisedby=? ";
738
0
        push @query_params, $userenv->{'number'};
739    }
740
0
    if ($basketno) {
741
0
        $strsth .= " AND aqbasket.basketno=? ";
742
0
        push @query_params, $basketno;
743    }
744
0
    $strsth .= " group by aqbasket.basketno" if $grouped;
745
0
    $strsth .= " order by aqbasket.basketno";
746
747
0
    my $sth = $dbh->prepare($strsth);
748
0
    $sth->execute( @query_params );
749
0
    my $results = $sth->fetchall_arrayref({});
750
0
    $sth->finish;
751
0
    return $results;
752}
753
754#------------------------------------------------------------#
755
756 - 769
=head3 GetOrders

  @orders = &GetOrders($basketnumber, $orderby);

Looks up the pending (non-cancelled) orders with the given basket
number. If C<$booksellerID> is non-empty, only orders from that seller
are returned.

return :
C<&basket> returns a two-element array. C<@orders> is an array of
references-to-hash, whose keys are the fields from the aqorders,
biblio, and biblioitems tables in the Koha database.

=cut
770
771sub GetOrders {
772
0
    my ( $basketno, $orderby ) = @_;
773
0
    my $dbh = C4::Context->dbh;
774
0
    my $query ="
775        SELECT biblio.*,biblioitems.*,
776                aqorders.*,
777                aqbudgets.*,
778                biblio.title
779        FROM aqorders
780            LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
781            LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
782            LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
783        WHERE basketno=?
784            AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
785    ";
786
787
0
    $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
788
0
    $query .= " ORDER BY $orderby";
789
0
    my $sth = $dbh->prepare($query);
790
0
    $sth->execute($basketno);
791
0
    my $results = $sth->fetchall_arrayref({});
792
0
    $sth->finish;
793
0
    return @$results;
794}
795
796#------------------------------------------------------------#
797
798 - 812
=head3 GetOrderNumber

  $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);

Looks up the ordernumber with the given biblionumber and biblioitemnumber.

Returns the number of this order.

=over

=item C<$ordernumber> is the order number.

=back

=cut
813
814sub GetOrderNumber {
815
0
    my ( $biblionumber,$biblioitemnumber ) = @_;
816
0
    my $dbh = C4::Context->dbh;
817
0
    my $query = "
818        SELECT ordernumber
819        FROM aqorders
820        WHERE biblionumber=?
821        AND biblioitemnumber=?
822    ";
823
0
    my $sth = $dbh->prepare($query);
824
0
    $sth->execute( $biblionumber, $biblioitemnumber );
825
826
0
    return $sth->fetchrow;
827}
828
829#------------------------------------------------------------#
830
831 - 840
=head3 GetOrder

  $order = &GetOrder($ordernumber);

Looks up an order by order number.

Returns a reference-to-hash describing the order. The keys of
C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.

=cut
841
842sub GetOrder {
843
0
    my ($ordernumber) = @_;
844
0
    my $dbh = C4::Context->dbh;
845
0
    my $query = "
846        SELECT biblioitems.*, biblio.*, aqorders.*
847        FROM aqorders
848        LEFT JOIN biblio on biblio.biblionumber=aqorders.biblionumber
849        LEFT JOIN biblioitems on biblioitems.biblionumber=aqorders.biblionumber
850        WHERE aqorders.ordernumber=?
851
852    ";
853
0
    my $sth= $dbh->prepare($query);
854
0
    $sth->execute($ordernumber);
855
0
    my $data = $sth->fetchrow_hashref;
856
0
    $sth->finish;
857
0
    return $data;
858}
859
860#------------------------------------------------------------#
861
862 - 890
=head3 NewOrder

  &NewOrder(\%hashref);

Adds a new order to the database. Any argument that isn't described
below is the new value of the field with the same name in the aqorders
table of the Koha database.

=over

=item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory

=item $hashref->{'ordernumber'} is a "minimum order number."

=item $hashref->{'budgetdate'} is effectively ignored.
If it's undef (anything false) or the string 'now', the current day is used.
Else, the upcoming July 1st is used.

=item $hashref->{'subscription'} may be either "yes", or anything else for "no".

=item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"

=item defaults entrydate to Now

The following keys are used: "biblionumber", "title", "basketno", "quantity", "notes", "biblioitemnumber", "rrp", "ecost", "gst", "unitprice", "subscription", "sort1", "sort2", "booksellerinvoicenumber", "listprice", "budgetdate", "purchaseordernumber", "branchcode", "booksellerinvoicenumber", "bookfundid".

=back

=cut
891
892sub NewOrder {
893
0
    my $orderinfo = shift;
894#### ------------------------------
895
0
    my $dbh = C4::Context->dbh;
896
0
    my @params;
897
898
899    # if these parameters are missing, we can't continue
900
0
    for my $key (qw/basketno quantity biblionumber budget_id/) {
901
0
        croak "Mandatory parameter $key missing" unless $orderinfo->{$key};
902    }
903
904
0
    if ( defined $orderinfo->{subscription} && $orderinfo->{'subscription'} eq 'yes' ) {
905
0
        $orderinfo->{'subscription'} = 1;
906    } else {
907
0
        $orderinfo->{'subscription'} = 0;
908    }
909
0
    $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
910
0
    if (!$orderinfo->{quantityreceived}) {
911
0
        $orderinfo->{quantityreceived} = 0;
912    }
913
914
0
    my $ordernumber=InsertInTable("aqorders",$orderinfo);
915
0
    return ( $orderinfo->{'basketno'}, $ordernumber );
916}
917
918
919
920#------------------------------------------------------------#
921
922 - 926
=head3 NewOrderItem

  &NewOrderItem();

=cut
927
928sub NewOrderItem {
929
0
    my ($itemnumber, $ordernumber) = @_;
930
0
    my $dbh = C4::Context->dbh;
931
0
    my $query = qq|
932            INSERT INTO aqorders_items
933                (itemnumber, ordernumber)
934            VALUES (?,?) |;
935
936
0
    my $sth = $dbh->prepare($query);
937
0
    $sth->execute( $itemnumber, $ordernumber);
938}
939
940#------------------------------------------------------------#
941
942 - 951
=head3 ModOrder

  &ModOrder(\%hashref);

Modifies an existing order. Updates the order with order number
$hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All 
other keys of the hash update the fields with the same name in the aqorders 
table of the Koha database.

=cut
952
953sub ModOrder {
954
0
    my $orderinfo = shift;
955
956
0
    die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '' ;
957
0
    die "Biblionumber is required" if $orderinfo->{'biblionumber'} eq '';
958
959
0
    my $dbh = C4::Context->dbh;
960
0
    my @params;
961
962    # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
963
0
    $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
964
965# delete($orderinfo->{'branchcode'});
966    # the hash contains a lot of entries not in aqorders, so get the columns ...
967
0
    my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
968
0
    $sth->execute;
969
0
    my $colnames = $sth->{NAME};
970
0
    my $query = "UPDATE aqorders SET ";
971
972
0
    foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
973        # ... and skip hash entries that are not in the aqorders table
974        # FIXME : probably not the best way to do it (would be better to have a correct hash)
975
0
        next unless grep(/^$orderinfokey$/, @$colnames);
976
0
            $query .= "$orderinfokey=?, ";
977
0
            push(@params, $orderinfo->{$orderinfokey});
978    }
979
980
0
    $query .= "timestamp=NOW() WHERE ordernumber=?";
981# push(@params, $specorderinfo{'ordernumber'});
982
0
    push(@params, $orderinfo->{'ordernumber'} );
983
0
    $sth = $dbh->prepare($query);
984
0
    $sth->execute(@params);
985
0
    $sth->finish;
986}
987
988#------------------------------------------------------------#
989
990 - 1004
=head3 ModOrderItem

  &ModOrderItem(\%hashref);

Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:

=over

=item - itemnumber: the old itemnumber
=item - ordernumber: the order this item is attached to
=item - newitemnumber: the new itemnumber we want to attach the line to

=back

=cut
1005
1006sub ModOrderItem {
1007
0
    my $orderiteminfo = shift;
1008
0
    if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1009
0
        die "Ordernumber, itemnumber and newitemnumber is required";
1010    }
1011
1012
0
    my $dbh = C4::Context->dbh;
1013
1014
0
    my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1015
0
    my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1016
0
    my $sth = $dbh->prepare($query);
1017
0
    $sth->execute(@params);
1018
0
    return 0;
1019}
1020
1021#------------------------------------------------------------#
1022
1023
1024 - 1031
=head3 ModOrderBibliotemNumber

  &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber);

Modifies the biblioitemnumber for an existing order.
Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.

=cut
1032
1033#FIXME: is this used at all?
1034sub ModOrderBiblioitemNumber {
1035
0
    my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1036
0
    my $dbh = C4::Context->dbh;
1037
0
    my $query = "
1038    UPDATE aqorders
1039    SET biblioitemnumber = ?
1040    WHERE ordernumber = ?
1041    AND biblionumber = ?";
1042
0
    my $sth = $dbh->prepare($query);
1043
0
    $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber );
1044}
1045
1046 - 1052
=head3 GetCancelledOrders

  my @orders = GetCancelledOrders($basketno, $orderby);

Returns cancelled orders for a basket

=cut
1053
1054sub GetCancelledOrders {
1055
0
    my ( $basketno, $orderby ) = @_;
1056
1057
0
    return () unless $basketno;
1058
1059
0
    my $dbh = C4::Context->dbh;
1060
0
    my $query = "
1061        SELECT biblio.*, biblioitems.*, aqorders.*, aqbudgets.*
1062        FROM aqorders
1063          LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1064          LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1065          LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1066        WHERE basketno = ?
1067          AND (datecancellationprinted IS NOT NULL
1068               AND datecancellationprinted <> '0000-00-00')
1069    ";
1070
1071
0
    $orderby = "aqorders.datecancellationprinted desc, aqorders.timestamp desc"
1072        unless $orderby;
1073
0
    $query .= " ORDER BY $orderby";
1074
0
    my $sth = $dbh->prepare($query);
1075
0
    $sth->execute($basketno);
1076
0
    my $results = $sth->fetchall_arrayref( {} );
1077
1078
0
    return @$results;
1079}
1080
1081
1082#------------------------------------------------------------#
1083
1084 - 1100
=head3 ModReceiveOrder

  &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
    $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
    $freight, $bookfund, $rrp);

Updates an order, to reflect the fact that it was received, at least
in part. All arguments not mentioned below update the fields with the
same name in the aqorders table of the Koha database.

If a partial order is received, splits the order into two.  The received
portion must have a booksellerinvoicenumber.

Updates the order with bibilionumber C<$biblionumber> and ordernumber
C<$ordernumber>.

=cut
1101
1102
1103sub ModReceiveOrder {
1104    my (
1105
0
        $biblionumber, $ordernumber, $quantrec, $user, $cost,
1106        $invoiceno, $freight, $rrp, $budget_id, $datereceived
1107    )
1108    = @_;
1109
0
    my $dbh = C4::Context->dbh;
1110
0
    $datereceived = C4::Dates->output('iso') unless $datereceived;
1111
0
    my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber );
1112
0
    if ($suggestionid) {
1113
0
        ModSuggestion( {suggestionid=>$suggestionid,
1114                        STATUS=>'AVAILABLE',
1115                        biblionumber=> $biblionumber}
1116                        );
1117    }
1118
1119
0
    my $sth=$dbh->prepare("
1120        SELECT * FROM aqorders
1121        WHERE biblionumber=? AND aqorders.ordernumber=?");
1122
1123
0
    $sth->execute($biblionumber,$ordernumber);
1124
0
    my $order = $sth->fetchrow_hashref();
1125
0
    $sth->finish();
1126
1127
0
    if ( $order->{quantity} > $quantrec ) {
1128
0
        $sth=$dbh->prepare("
1129            UPDATE aqorders
1130            SET quantityreceived=?
1131                , datereceived=?
1132                , booksellerinvoicenumber=?
1133                , unitprice=?
1134                , freight=?
1135                , rrp=?
1136                , quantity=?
1137            WHERE biblionumber=? AND ordernumber=?");
1138
1139
0
        $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordernumber);
1140
0
        $sth->finish;
1141
1142        # create a new order for the remaining items, and set its bookfund.
1143
0
        foreach my $orderkey ( "linenumber", "allocation" ) {
1144
0
            delete($order->{'$orderkey'});
1145        }
1146
0
        $order->{'quantity'} -= $quantrec;
1147
0
        $order->{'quantityreceived'} = 0;
1148
0
        my $newOrder = NewOrder($order);
1149} else {
1150
0
        $sth=$dbh->prepare("update aqorders
1151                            set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
1152                                unitprice=?,freight=?,rrp=?
1153                            where biblionumber=? and ordernumber=?");
1154
0
        $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordernumber);
1155
0
        $sth->finish;
1156    }
1157
0
    return $datereceived;
1158}
1159#------------------------------------------------------------#
1160
1161 - 1193
=head3 SearchOrder

@results = &SearchOrder($search, $biblionumber, $complete);

Searches for orders.

C<$search> may take one of several forms: if it is an ISBN,
C<&ordersearch> returns orders with that ISBN. If C<$search> is an
order number, C<&ordersearch> returns orders with that order number
and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
to be a space-separated list of search terms; in this case, all of the
terms must appear in the title (matching the beginning of title
words).

If C<$complete> is C<yes>, the results will include only completed
orders. In any case, C<&ordersearch> ignores cancelled orders.

C<&ordersearch> returns an array.
C<@results> is an array of references-to-hash with the following keys:

=over 4

=item C<author>

=item C<seriestitle>

=item C<branchcode>

=item C<bookfundid>

=back

=cut
1194
1195sub SearchOrder {
1196#### -------- SearchOrder-------------------------------
1197
0
    my ($ordernumber, $search, $supplierid, $basket) = @_;
1198
1199
0
    my $dbh = C4::Context->dbh;
1200
0
    my @args = ();
1201
0
    my $query =
1202            "SELECT *
1203            FROM aqorders
1204            LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1205            LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1206            LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1207                WHERE (datecancellationprinted is NULL)";
1208
1209
0
    if($ordernumber){
1210
0
        $query .= " AND (aqorders.ordernumber=?)";
1211
0
        push @args, $ordernumber;
1212    }
1213
0
    if($search){
1214
0
        $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1215
0
        push @args, ("%$search%","%$search%","%$search%");
1216    }
1217
0
    if($supplierid){
1218
0
        $query .= "AND aqbasket.booksellerid = ?";
1219
0
        push @args, $supplierid;
1220    }
1221
0
    if($basket){
1222
0
        $query .= "AND aqorders.basketno = ?";
1223
0
        push @args, $basket;
1224    }
1225
1226
0
    my $sth = $dbh->prepare($query);
1227
0
    $sth->execute(@args);
1228
0
    my $results = $sth->fetchall_arrayref({});
1229
0
    $sth->finish;
1230
0
    return $results;
1231}
1232
1233#------------------------------------------------------------#
1234
1235 - 1243
=head3 DelOrder

  &DelOrder($biblionumber, $ordernumber);

Cancel the order with the given order and biblio numbers. It does not
delete any entries in the aqorders table, it merely marks them as
cancelled.

=cut
1244
1245sub DelOrder {
1246
0
    my ( $bibnum, $ordernumber ) = @_;
1247
0
    my $dbh = C4::Context->dbh;
1248
0
    my $query = "
1249        UPDATE aqorders
1250        SET datecancellationprinted=now()
1251        WHERE biblionumber=? AND ordernumber=?
1252    ";
1253
0
    my $sth = $dbh->prepare($query);
1254
0
    $sth->execute( $bibnum, $ordernumber );
1255
0
    $sth->finish;
1256
0
    my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1257
0
    foreach my $itemnumber (@itemnumbers){
1258
0
     C4::Items::DelItem( $dbh, $bibnum, $itemnumber );
1259    }
1260
1261}
1262
1263 - 1265
=head2 FUNCTIONS ABOUT PARCELS

=cut
1266
1267#------------------------------------------------------------#
1268
1269 - 1281
=head3 GetParcel

  @results = &GetParcel($booksellerid, $code, $date);

Looks up all of the received items from the supplier with the given
bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.

C<@results> is an array of references-to-hash. The keys of each element are fields from
the aqorders, biblio, and biblioitems tables of the Koha database.

C<@results> is sorted alphabetically by book title.

=cut
1282
1283sub GetParcel {
1284    #gets all orders from a certain supplier, orders them alphabetically
1285
0
    my ( $supplierid, $code, $datereceived ) = @_;
1286
0
    my $dbh = C4::Context->dbh;
1287
0
    my @results = ();
1288
0
    $code .= '%'
1289    if $code; # add % if we search on a given code (otherwise, let him empty)
1290
0
    my $strsth ="
1291        SELECT authorisedby,
1292                creationdate,
1293                aqbasket.basketno,
1294                closedate,surname,
1295                firstname,
1296                aqorders.biblionumber,
1297                aqorders.ordernumber,
1298                aqorders.quantity,
1299                aqorders.quantityreceived,
1300                aqorders.unitprice,
1301                aqorders.listprice,
1302                aqorders.rrp,
1303                aqorders.ecost,
1304                biblio.title
1305        FROM aqorders
1306        LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1307        LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1308        LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1309        WHERE
1310            aqbasket.booksellerid = ?
1311            AND aqorders.booksellerinvoicenumber LIKE ?
1312            AND aqorders.datereceived = ? ";
1313
1314
0
    my @query_params = ( $supplierid, $code, $datereceived );
1315
0
    if ( C4::Context->preference("IndependantBranches") ) {
1316
0
        my $userenv = C4::Context->userenv;
1317
0
        if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1318
0
            $strsth .= " and (borrowers.branchcode = ?
1319                        or borrowers.branchcode = '')";
1320
0
            push @query_params, $userenv->{branch};
1321        }
1322    }
1323
0
    $strsth .= " ORDER BY aqbasket.basketno";
1324    # ## parcelinformation : $strsth
1325
0
    my $sth = $dbh->prepare($strsth);
1326
0
    $sth->execute( @query_params );
1327
0
    while ( my $data = $sth->fetchrow_hashref ) {
1328
0
        push( @results, $data );
1329    }
1330    # ## countparcelbiblio: scalar(@results)
1331
0
    $sth->finish;
1332
1333
0
    return @results;
1334}
1335
1336#------------------------------------------------------------#
1337
1338 - 1377
=head3 GetParcels

  $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);

get a lists of parcels.

* Input arg :

=over

=item $bookseller
is the bookseller this function has to get parcels.

=item $order
To know on what criteria the results list has to be ordered.

=item $code
is the booksellerinvoicenumber.

=item $datefrom & $dateto
to know on what date this function has to filter its search.

=back

* return:
a pointer on a hash list containing parcel informations as such :

=over

=item Creation date

=item Last operation

=item Number of biblio

=item Number of items

=back

=cut
1378
1379sub GetParcels {
1380
0
    my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1381
0
    my $dbh = C4::Context->dbh;
1382
0
    my @query_params = ();
1383
0
    my $strsth ="
1384        SELECT aqorders.booksellerinvoicenumber,
1385                datereceived,purchaseordernumber,
1386                count(DISTINCT biblionumber) AS biblio,
1387                sum(quantity) AS itemsexpected,
1388                sum(quantityreceived) AS itemsreceived
1389        FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1390        WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1391    ";
1392
0
    push @query_params, $bookseller;
1393
1394
0
    if ( defined $code ) {
1395
0
        $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
1396        # add a % to the end of the code to allow stemming.
1397
0
        push @query_params, "$code%";
1398    }
1399
1400
0
    if ( defined $datefrom ) {
1401
0
        $strsth .= ' and datereceived >= ? ';
1402
0
        push @query_params, $datefrom;
1403    }
1404
1405
0
    if ( defined $dateto ) {
1406
0
        $strsth .= 'and datereceived <= ? ';
1407
0
        push @query_params, $dateto;
1408    }
1409
1410
0
    $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1411
1412    # can't use a placeholder to place this column name.
1413    # but, we could probably be checking to make sure it is a column that will be fetched.
1414
0
    $strsth .= "order by $order " if ($order);
1415
1416
0
    my $sth = $dbh->prepare($strsth);
1417
1418
0
    $sth->execute( @query_params );
1419
0
    my $results = $sth->fetchall_arrayref({});
1420
0
    $sth->finish;
1421
0
    return @$results;
1422}
1423
1424#------------------------------------------------------------#
1425
1426 - 1435
=head3 GetLateOrders

  @results = &GetLateOrders;

Searches for bookseller with late orders.

return:
the table of supplier with late issues. This table is full of hashref.

=cut
1436
1437sub GetLateOrders {
1438
0
    my $delay = shift;
1439
0
    my $supplierid = shift;
1440
0
    my $branch = shift;
1441
1442
0
    my $dbh = C4::Context->dbh;
1443
1444    #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1445
0
    my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1446
1447
0
    my @query_params = ($delay); # delay is the first argument regardless
1448
0
    my $select = "
1449    SELECT aqbasket.basketno,
1450        aqorders.ordernumber,
1451        DATE(aqbasket.closedate) AS orderdate,
1452        aqorders.rrp AS unitpricesupplier,
1453        aqorders.ecost AS unitpricelib,
1454        aqorders.claims_count AS claims_count,
1455        aqorders.claimed_date AS claimed_date,
1456        aqbudgets.budget_name AS budget,
1457        borrowers.branchcode AS branch,
1458        aqbooksellers.name AS supplier,
1459        aqbooksellers.id AS supplierid,
1460        biblio.author, biblio.title,
1461        biblioitems.publishercode AS publisher,
1462        biblioitems.publicationyear,
1463    ";
1464
0
    my $from = "
1465    FROM
1466        aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1467        LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1468        LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1469        aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
1470        LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1471        WHERE aqorders.basketno = aqbasket.basketno
1472        AND ( datereceived = ''
1473            OR datereceived IS NULL
1474            OR aqorders.quantityreceived < aqorders.quantity
1475        )
1476        AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1477    ";
1478
0
    my $having = "";
1479
0
    if ($dbdriver eq "mysql") {
1480
0
        $select .= "
1481        aqorders.quantity - IFNULL(aqorders.quantityreceived,0) AS quantity,
1482        (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1483        DATEDIFF(CURDATE( ),closedate) AS latesince
1484        ";
1485
0
        $from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) ";
1486
0
        $having = "
1487        HAVING quantity <> 0
1488            AND unitpricesupplier <> 0
1489            AND unitpricelib <> 0
1490        ";
1491    } else {
1492        # FIXME: account for IFNULL as above
1493
0
        $select .= "
1494                aqorders.quantity AS quantity,
1495                aqorders.quantity * aqorders.rrp AS subtotal,
1496                (CURDATE - closedate) AS latesince
1497        ";
1498
0
        $from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) ";
1499    }
1500
0
    if (defined $supplierid) {
1501
0
        $from .= ' AND aqbasket.booksellerid = ? ';
1502
0
        push @query_params, $supplierid;
1503    }
1504
0
    if (defined $branch) {
1505
0
        $from .= ' AND borrowers.branchcode LIKE ? ';
1506
0
        push @query_params, $branch;
1507    }
1508
0
    if (C4::Context->preference("IndependantBranches")
1509            && C4::Context->userenv
1510            && C4::Context->userenv->{flags} != 1 ) {
1511
0
        $from .= ' AND borrowers.branchcode LIKE ? ';
1512
0
        push @query_params, C4::Context->userenv->{branch};
1513    }
1514
0
    my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1515
0
    $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1516
0
    my $sth = $dbh->prepare($query);
1517
0
    $sth->execute(@query_params);
1518
0
    my @results;
1519
0
    while (my $data = $sth->fetchrow_hashref) {
1520
0
        $data->{orderdate} = format_date($data->{orderdate});
1521
0
        $data->{claimed_date} = format_date($data->{claimed_date});
1522
0
        push @results, $data;
1523    }
1524
0
    return @results;
1525}
1526
1527#------------------------------------------------------------#
1528
1529 - 1566
=head3 GetHistory

  (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( %params );

Retreives some acquisition history information

params:  
  title
  author
  name
  from_placed_on
  to_placed_on
  basket                  - search both basket name and number
  booksellerinvoicenumber 

returns:
    $order_loop is a list of hashrefs that each look like this:
            {
                'author'           => 'Twain, Mark',
                'basketno'         => '1',
                'biblionumber'     => '215',
                'count'            => 1,
                'creationdate'     => 'MM/DD/YYYY',
                'datereceived'     => undef,
                'ecost'            => '1.00',
                'id'               => '1',
                'invoicenumber'    => undef,
                'name'             => '',
                'ordernumber'      => '1',
                'quantity'         => 1,
                'quantityreceived' => undef,
                'title'            => 'The Adventures of Huckleberry Finn'
            }
    $total_qty is the sum of all of the quantities in $order_loop
    $total_price is the cost of each in $order_loop times the quantity
    $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop

=cut
1567
1568sub GetHistory {
1569# don't run the query if there are no parameters (list would be too long for sure !)
1570
0
    croak "No search params" unless @_;
1571
0
    my %params = @_;
1572
0
    my $title = $params{title};
1573
0
    my $author = $params{author};
1574
0
    my $isbn = $params{isbn};
1575
0
    my $name = $params{name};
1576
0
    my $from_placed_on = $params{from_placed_on};
1577
0
    my $to_placed_on = $params{to_placed_on};
1578
0
    my $basket = $params{basket};
1579
0
    my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
1580
1581
0
    my @order_loop;
1582
0
    my $total_qty = 0;
1583
0
    my $total_qtyreceived = 0;
1584
0
    my $total_price = 0;
1585
1586
0
    my $dbh = C4::Context->dbh;
1587
0
    my $query ="
1588        SELECT
1589            biblio.title,
1590            biblio.author,
1591            biblioitems.isbn,
1592            aqorders.basketno,
1593    aqbasket.basketname,
1594    aqbasket.basketgroupid,
1595    aqbasketgroups.name as groupname,
1596            aqbooksellers.name,
1597    aqbasket.creationdate,
1598            aqorders.datereceived,
1599            aqorders.quantity,
1600            aqorders.quantityreceived,
1601            aqorders.ecost,
1602            aqorders.ordernumber,
1603            aqorders.booksellerinvoicenumber as invoicenumber,
1604            aqbooksellers.id as id,
1605            aqorders.biblionumber
1606        FROM aqorders
1607        LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1608    LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
1609        LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1610        LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
1611        LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1612
1613
0
    $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1614    if ( C4::Context->preference("IndependantBranches") );
1615
1616
0
    $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1617
1618
0
    my @query_params = ();
1619
1620
0
    if ( $title ) {
1621
0
        $query .= " AND biblio.title LIKE ? ";
1622
0
        $title =~ s/\s+/%/g;
1623
0
        push @query_params, "%$title%";
1624    }
1625
1626
0
    if ( $author ) {
1627
0
        $query .= " AND biblio.author LIKE ? ";
1628
0
        push @query_params, "%$author%";
1629    }
1630
1631
0
    if ( $isbn ) {
1632
0
        $query .= " AND biblioitems.isbn LIKE ? ";
1633
0
        push @query_params, "%$isbn%";
1634    }
1635
1636
0
    if ( $name ) {
1637
0
        $query .= " AND aqbooksellers.name LIKE ? ";
1638
0
        push @query_params, "%$name%";
1639    }
1640
1641
0
    if ( $from_placed_on ) {
1642
0
        $query .= " AND creationdate >= ? ";
1643
0
        push @query_params, $from_placed_on;
1644    }
1645
1646
0
    if ( $to_placed_on ) {
1647
0
        $query .= " AND creationdate <= ? ";
1648
0
        push @query_params, $to_placed_on;
1649    }
1650
1651
0
    if ($basket) {
1652
0
        if ($basket =~ m/^\d+$/) {
1653
0
            $query .= " AND aqorders.basketno = ? ";
1654
0
            push @query_params, $basket;
1655        } else {
1656
0
            $query .= " AND aqbasket.basketname LIKE ? ";
1657
0
            push @query_params, "%$basket%";
1658        }
1659    }
1660
1661
0
    if ($booksellerinvoicenumber) {
1662
0
        $query .= " AND (aqorders.booksellerinvoicenumber LIKE ? OR aqbasket.booksellerinvoicenumber LIKE ?)";
1663
0
        push @query_params, "%$booksellerinvoicenumber%", "%$booksellerinvoicenumber%";
1664    }
1665
1666
0
    if ( C4::Context->preference("IndependantBranches") ) {
1667
0
        my $userenv = C4::Context->userenv;
1668
0
        if ( $userenv && ($userenv->{flags} || 0) != 1 ) {
1669
0
            $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1670
0
            push @query_params, $userenv->{branch};
1671        }
1672    }
1673
0
    $query .= " ORDER BY id";
1674
0
    my $sth = $dbh->prepare($query);
1675
0
    $sth->execute( @query_params );
1676
0
    my $cnt = 1;
1677
0
    while ( my $line = $sth->fetchrow_hashref ) {
1678
0
        $line->{count} = $cnt++;
1679
0
        $line->{toggle} = 1 if $cnt % 2;
1680
0
        push @order_loop, $line;
1681
0
        $total_qty += $line->{'quantity'};
1682
0
        $total_qtyreceived += $line->{'quantityreceived'};
1683
0
        $total_price += $line->{'quantity'} * $line->{'ecost'};
1684    }
1685
0
    return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1686}
1687
1688 - 1694
=head2 GetRecentAcqui

  $results = GetRecentAcqui($days);

C<$results> is a ref to a table which containts hashref

=cut
1695
1696sub GetRecentAcqui {
1697
0
    my $limit = shift;
1698
0
    my $dbh = C4::Context->dbh;
1699
0
    my $query = "
1700        SELECT *
1701        FROM biblio
1702        ORDER BY timestamp DESC
1703        LIMIT 0,".$limit;
1704
1705
0
    my $sth = $dbh->prepare($query);
1706
0
    $sth->execute;
1707
0
    my $results = $sth->fetchall_arrayref({});
1708
0
    return $results;
1709}
1710
1711 - 1727
=head3 GetContracts

  $contractlist = &GetContracts($booksellerid, $activeonly);

Looks up the contracts that belong to a bookseller

Returns a list of contracts

=over

=item C<$booksellerid> is the "id" field in the "aqbooksellers" table.

=item C<$activeonly> if exists get only contracts that are still active.

=back

=cut
1728
1729sub GetContracts {
1730
0
    my ( $booksellerid, $activeonly ) = @_;
1731
0
    my $dbh = C4::Context->dbh;
1732
0
    my $query;
1733
0
    if (! $activeonly) {
1734
0
        $query = "
1735            SELECT *
1736            FROM aqcontract
1737            WHERE booksellerid=?
1738        ";
1739    } else {
1740
0
        $query = "SELECT *
1741            FROM aqcontract
1742            WHERE booksellerid=?
1743                AND contractenddate >= CURDATE( )";
1744    }
1745
0
    my $sth = $dbh->prepare($query);
1746
0
    $sth->execute( $booksellerid );
1747
0
    my @results;
1748
0
    while (my $data = $sth->fetchrow_hashref ) {
1749
0
        push(@results, $data);
1750    }
1751
0
    $sth->finish;
1752
0
    return @results;
1753}
1754
1755#------------------------------------------------------------#
1756
1757 - 1765
=head3 GetContract

  $contract = &GetContract($contractID);

Looks up the contract that has PRIMKEY (contractnumber) value $contractID

Returns a contract

=cut
1766
1767sub GetContract {
1768
0
    my ( $contractno ) = @_;
1769
0
    my $dbh = C4::Context->dbh;
1770
0
    my $query = "
1771        SELECT *
1772        FROM aqcontract
1773        WHERE contractnumber=?
1774        ";
1775
1776
0
    my $sth = $dbh->prepare($query);
1777
0
    $sth->execute( $contractno );
1778
0
    my $result = $sth->fetchrow_hashref;
1779
0
    return $result;
1780}
1781
1782 - 1792
=head3 AddClaim

=over 4

&AddClaim($ordernumber);

Add a claim for an order

=back

=cut
1793sub AddClaim {
1794
0
    my ($ordernumber) = @_;
1795
0
    my $dbh = C4::Context->dbh;
1796
0
    my $query = "
1797        UPDATE aqorders SET
1798            claims_count = claims_count + 1,
1799            claimed_date = CURDATE()
1800        WHERE ordernumber = ?
1801        ";
1802
0
    my $sth = $dbh->prepare($query);
1803
0
    $sth->execute($ordernumber);
1804
1805}
1806
18071;