1 package C4
::Acquisition
;
3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
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
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.
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.
25 use C4
::Dates
qw(format_date format_date_in_iso);
31 use C4
::Templates
qw(gettemplate);
32 use Koha
::DateUtils
qw( dt_from_string output_pref );
33 use Koha
::Acquisition
::Order
;
34 use Koha
::Acquisition
::Bookseller
;
35 use Koha
::Number
::Price
;
40 use vars
qw($VERSION @ISA @EXPORT);
43 # set the version for version checking
44 $VERSION = 3.07.00.049;
48 &GetBasket &NewBasket &CloseBasket &ReopenBasket &DelBasket &ModBasket
49 &GetBasketAsCSV &GetBasketGroupAsCSV
50 &GetBasketsByBookseller &GetBasketsByBasketgroup
51 &GetBasketsInfosByBookseller
53 &GetBasketUsers &ModBasketUsers
58 &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup
59 &GetBasketgroups &ReOpenBasketgroup
61 &DelOrder &ModOrder &GetOrder &GetOrders &GetOrdersByBiblionumber
62 &GetLateOrders &GetOrderFromItemnumber
63 &SearchOrders &GetHistory &GetRecentAcqui
64 &ModReceiveOrder &CancelReceipt
65 &GetCancelledOrders &TransferOrder
66 &GetLastOrderNotReceivedFromSubscriptionid &GetLastOrderReceivedFromSubscriptionid
81 &GetItemnumbersFromOrder
84 &GetBiblioCountByBasketno
92 sub GetOrderFromItemnumber
{
93 my ($itemnumber) = @_;
94 my $dbh = C4
::Context
->dbh;
97 SELECT
* from aqorders LEFT JOIN aqorders_items
98 ON
( aqorders
.ordernumber
= aqorders_items
.ordernumber
)
99 WHERE itemnumber
= ?
|;
101 my $sth = $dbh->prepare($query);
105 $sth->execute($itemnumber);
107 my $order = $sth->fetchrow_hashref;
112 # Returns the itemnumber(s) associated with the ordernumber given in parameter
113 sub GetItemnumbersFromOrder
{
114 my ($ordernumber) = @_;
115 my $dbh = C4
::Context
->dbh;
116 my $query = "SELECT itemnumber FROM aqorders_items WHERE ordernumber=?";
117 my $sth = $dbh->prepare($query);
118 $sth->execute($ordernumber);
121 while (my $order = $sth->fetchrow_hashref) {
122 push @tab, $order->{'itemnumber'};
136 C4::Acquisition - Koha functions for dealing with orders and acquisitions
144 The functions in this module deal with acquisitions, managing book
145 orders, basket and parcels.
149 =head2 FUNCTIONS ABOUT BASKETS
153 $aqbasket = &GetBasket($basketnumber);
155 get all basket informations in aqbasket for a given basket
157 B<returns:> informations for a given basket returned as a hashref.
163 my $dbh = C4
::Context
->dbh;
166 concat( b.firstname,' ',b.surname) AS authorisedbyname
168 LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
171 my $sth=$dbh->prepare($query);
172 $sth->execute($basketno);
173 my $basket = $sth->fetchrow_hashref;
177 #------------------------------------------------------------#
181 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
182 $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace );
184 Create a new basket in aqbasket table
188 =item C<$booksellerid> is a foreign key in the aqbasket table
190 =item C<$authorizedby> is the username of who created the basket
194 The other parameters are optional, see ModBasketHeader for more info on them.
199 my ( $booksellerid, $authorisedby, $basketname, $basketnote,
200 $basketbooksellernote, $basketcontractnumber, $deliveryplace,
201 $billingplace ) = @_;
202 my $dbh = C4
::Context
->dbh;
204 'INSERT INTO aqbasket (creationdate,booksellerid,authorisedby) '
205 . 'VALUES (now(),?,?)';
206 $dbh->do( $query, {}, $booksellerid, $authorisedby );
208 my $basket = $dbh->{mysql_insertid
};
209 $basketname ||= q{}; # default to empty strings
211 $basketbooksellernote ||= q{};
212 ModBasketHeader
( $basket, $basketname, $basketnote, $basketbooksellernote,
213 $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace );
217 #------------------------------------------------------------#
221 &CloseBasket($basketno);
223 close a basket (becomes unmodifiable, except for receives)
229 my $dbh = C4
::Context
->dbh;
235 my $sth = $dbh->prepare($query);
236 $sth->execute($basketno);
238 my @orders = GetOrders
($basketno);
239 foreach my $order (@orders) {
242 SET orderstatus
= 'ordered'
243 WHERE ordernumber
= ?
;
245 $sth = $dbh->prepare($query);
246 $sth->execute($order->{'ordernumber'});
252 &ReopenBasket($basketno);
260 my $dbh = C4
::Context
->dbh;
266 my $sth = $dbh->prepare($query);
267 $sth->execute($basketno);
269 my @orders = GetOrders
($basketno);
270 foreach my $order (@orders) {
273 SET orderstatus
= 'new'
274 WHERE ordernumber
= ?
;
276 $sth = $dbh->prepare($query);
277 $sth->execute($order->{'ordernumber'});
281 #------------------------------------------------------------#
283 =head3 GetBasketAsCSV
285 &GetBasketAsCSV($basketno);
287 Export a basket as CSV
289 $cgi parameter is needed for column name translation
294 my ($basketno, $cgi) = @_;
295 my $basket = GetBasket
($basketno);
296 my @orders = GetOrders
($basketno);
297 my $contract = GetContract
({
298 contractnumber
=> $basket->{'contractnumber'}
301 my $template = C4
::Templates
::gettemplate
("acqui/csv/basket.tt", "intranet", $cgi);
304 foreach my $order (@orders) {
305 my $bd = GetBiblioData
( $order->{'biblionumber'} );
307 contractname
=> $contract->{'contractname'},
308 ordernumber
=> $order->{'ordernumber'},
309 entrydate
=> $order->{'entrydate'},
310 isbn
=> $order->{'isbn'},
311 author
=> $bd->{'author'},
312 title
=> $bd->{'title'},
313 publicationyear
=> $bd->{'publicationyear'},
314 publishercode
=> $bd->{'publishercode'},
315 collectiontitle
=> $bd->{'collectiontitle'},
316 notes
=> $order->{'order_vendornote'},
317 quantity
=> $order->{'quantity'},
318 rrp
=> $order->{'rrp'},
319 deliveryplace
=> C4
::Branch
::GetBranchName
( $basket->{'deliveryplace'} ),
320 billingplace
=> C4
::Branch
::GetBranchName
( $basket->{'billingplace'} ),
323 contractname author title publishercode collectiontitle notes
324 deliveryplace billingplace
326 # Double the quotes to not be interpreted as a field end
327 $row->{$_} =~ s/"/""/g if $row->{$_};
333 if(defined $a->{publishercode
} and defined $b->{publishercode
}) {
334 $a->{publishercode
} cmp $b->{publishercode
};
338 $template->param(rows
=> \
@rows);
340 return $template->output;
344 =head3 GetBasketGroupAsCSV
348 &GetBasketGroupAsCSV($basketgroupid);
350 Export a basket group as CSV
352 $cgi parameter is needed for column name translation
358 sub GetBasketGroupAsCSV
{
359 my ($basketgroupid, $cgi) = @_;
360 my $baskets = GetBasketsByBasketgroup
($basketgroupid);
362 my $template = C4
::Templates
::gettemplate
('acqui/csv/basketgroup.tt', 'intranet', $cgi);
365 for my $basket (@
$baskets) {
366 my @orders = GetOrders
( $basket->{basketno
} );
367 my $contract = GetContract
({
368 contractnumber
=> $basket->{contractnumber
}
370 my $bookseller = Koha
::Acquisition
::Bookseller
->fetch({ id
=> $basket->{booksellerid
} });
371 my $basketgroup = GetBasketgroup
( $$basket{basketgroupid
} );
373 foreach my $order (@orders) {
374 my $bd = GetBiblioData
( $order->{'biblionumber'} );
376 clientnumber
=> $bookseller->{accountnumber
},
377 basketname
=> $basket->{basketname
},
378 ordernumber
=> $order->{ordernumber
},
379 author
=> $bd->{author
},
380 title
=> $bd->{title
},
381 publishercode
=> $bd->{publishercode
},
382 publicationyear
=> $bd->{publicationyear
},
383 collectiontitle
=> $bd->{collectiontitle
},
384 isbn
=> $order->{isbn
},
385 quantity
=> $order->{quantity
},
386 rrp
=> $order->{rrp
},
387 discount
=> $bookseller->{discount
},
388 ecost
=> $order->{ecost
},
389 notes
=> $order->{order_vendornote
},
390 entrydate
=> $order->{entrydate
},
391 booksellername
=> $bookseller->{name
},
392 bookselleraddress
=> $bookseller->{address1
},
393 booksellerpostal
=> $bookseller->{postal
},
394 contractnumber
=> $contract->{contractnumber
},
395 contractname
=> $contract->{contractname
},
396 basketgroupdeliveryplace
=> C4
::Branch
::GetBranchName
( $basketgroup->{deliveryplace
} ),
397 basketgroupbillingplace
=> C4
::Branch
::GetBranchName
( $basketgroup->{billingplace
} ),
398 basketdeliveryplace
=> C4
::Branch
::GetBranchName
( $basket->{deliveryplace
} ),
399 basketbillingplace
=> C4
::Branch
::GetBranchName
( $basket->{billingplace
} ),
402 basketname author title publishercode collectiontitle notes
403 booksellername bookselleraddress booksellerpostal contractname
404 basketgroupdeliveryplace basketgroupbillingplace
405 basketdeliveryplace basketbillingplace
407 # Double the quotes to not be interpreted as a field end
408 $row->{$_} =~ s/"/""/g if $row->{$_};
413 $template->param(rows
=> \
@rows);
415 return $template->output;
419 =head3 CloseBasketgroup
421 &CloseBasketgroup($basketgroupno);
427 sub CloseBasketgroup
{
428 my ($basketgroupno) = @_;
429 my $dbh = C4
::Context
->dbh;
430 my $sth = $dbh->prepare("
431 UPDATE aqbasketgroups
435 $sth->execute($basketgroupno);
438 #------------------------------------------------------------#
440 =head3 ReOpenBaskergroup($basketgroupno)
442 &ReOpenBaskergroup($basketgroupno);
448 sub ReOpenBasketgroup
{
449 my ($basketgroupno) = @_;
450 my $dbh = C4
::Context
->dbh;
451 my $sth = $dbh->prepare("
452 UPDATE aqbasketgroups
456 $sth->execute($basketgroupno);
459 #------------------------------------------------------------#
464 &DelBasket($basketno);
466 Deletes the basket that has basketno field $basketno in the aqbasket table.
470 =item C<$basketno> is the primary key of the basket in the aqbasket table.
477 my ( $basketno ) = @_;
478 my $query = "DELETE FROM aqbasket WHERE basketno=?";
479 my $dbh = C4
::Context
->dbh;
480 my $sth = $dbh->prepare($query);
481 $sth->execute($basketno);
485 #------------------------------------------------------------#
489 &ModBasket($basketinfo);
491 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
495 =item C<$basketno> is the primary key of the basket in the aqbasket table.
502 my $basketinfo = shift;
503 my $query = "UPDATE aqbasket SET ";
505 foreach my $key (keys %$basketinfo){
506 if ($key ne 'basketno'){
507 $query .= "$key=?, ";
508 push(@params, $basketinfo->{$key} || undef );
511 # get rid of the "," at the end of $query
512 if (substr($query, length($query)-2) eq ', '){
517 $query .= "WHERE basketno=?";
518 push(@params, $basketinfo->{'basketno'});
519 my $dbh = C4
::Context
->dbh;
520 my $sth = $dbh->prepare($query);
521 $sth->execute(@params);
526 #------------------------------------------------------------#
528 =head3 ModBasketHeader
530 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
532 Modifies a basket's header.
536 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
538 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
540 =item C<$note> is the "note" field in the "aqbasket" table;
542 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
544 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
546 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
548 =item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
550 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
556 sub ModBasketHeader
{
557 my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace) = @_;
560 SET basketname
=?
, note
=?
, booksellernote
=?
, booksellerid
=?
, deliveryplace
=?
, billingplace
=?
564 my $dbh = C4
::Context
->dbh;
565 my $sth = $dbh->prepare($query);
566 $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $basketno);
568 if ( $contractnumber ) {
569 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
570 my $sth2 = $dbh->prepare($query2);
571 $sth2->execute($contractnumber,$basketno);
576 #------------------------------------------------------------#
578 =head3 GetBasketsByBookseller
580 @results = &GetBasketsByBookseller($booksellerid, $extra);
582 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
586 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
588 =item C<$extra> is the extra sql parameters, can be
590 $extra->{groupby}: group baskets by column
591 ex. $extra->{groupby} = aqbasket.basketgroupid
592 $extra->{orderby}: order baskets by column
593 $extra->{limit}: limit number of results (can be helpful for pagination)
599 sub GetBasketsByBookseller
{
600 my ($booksellerid, $extra) = @_;
601 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
603 if ($extra->{groupby
}) {
604 $query .= " GROUP by $extra->{groupby}";
606 if ($extra->{orderby
}){
607 $query .= " ORDER by $extra->{orderby}";
609 if ($extra->{limit
}){
610 $query .= " LIMIT $extra->{limit}";
613 my $dbh = C4
::Context
->dbh;
614 my $sth = $dbh->prepare($query);
615 $sth->execute($booksellerid);
616 return $sth->fetchall_arrayref({});
619 =head3 GetBasketsInfosByBookseller
621 my $baskets = GetBasketsInfosByBookseller($supplierid, $allbaskets);
623 The optional second parameter allbaskets is a boolean allowing you to
624 select all baskets from the supplier; by default only active baskets (open or
625 closed but still something to receive) are returned.
627 Returns in a arrayref of hashref all about booksellers baskets, plus:
628 total_biblios: Number of distinct biblios in basket
629 total_items: Number of items in basket
630 expected_items: Number of non-received items in basket
634 sub GetBasketsInfosByBookseller
{
635 my ($supplierid, $allbaskets) = @_;
637 return unless $supplierid;
639 my $dbh = C4
::Context
->dbh;
642 SUM(aqorders.quantity) AS total_items,
644 IF ( aqorders.orderstatus = 'cancelled', aqorders.quantity, 0 )
645 ) AS total_items_cancelled,
646 COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
648 IF(aqorders.datereceived IS NULL
649 AND aqorders.datecancellationprinted IS NULL
654 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
655 WHERE booksellerid = ?};
657 unless ( $allbaskets ) {
658 $query.=" AND (closedate IS NULL OR (aqorders.quantity > aqorders.quantityreceived AND datecancellationprinted IS NULL))";
660 $query.=" GROUP BY aqbasket.basketno";
662 my $sth = $dbh->prepare($query);
663 $sth->execute($supplierid);
664 my $baskets = $sth->fetchall_arrayref({});
666 # Retrieve the number of biblios cancelled
667 my $cancelled_biblios = $dbh->selectall_hashref( q
|
668 SELECT COUNT
(DISTINCT
(biblionumber
)) AS total_biblios_cancelled
, aqbasket
.basketno
670 LEFT JOIN aqorders ON aqorders
.basketno
= aqbasket
.basketno
671 WHERE booksellerid
= ?
672 AND aqorders
.orderstatus
= 'cancelled'
673 GROUP BY aqbasket
.basketno
674 |, 'basketno', {}, $supplierid );
676 $_->{total_biblios_cancelled
} = $cancelled_biblios->{$_->{basketno
}}{total_biblios_cancelled
} || 0
682 =head3 GetBasketUsers
684 $basketusers_ids = &GetBasketUsers($basketno);
686 Returns a list of all borrowernumbers that are in basket users list
691 my $basketno = shift;
693 return unless $basketno;
696 SELECT borrowernumber
700 my $dbh = C4
::Context
->dbh;
701 my $sth = $dbh->prepare($query);
702 $sth->execute($basketno);
703 my $results = $sth->fetchall_arrayref( {} );
706 foreach (@
$results) {
707 push @borrowernumbers, $_->{'borrowernumber'};
710 return @borrowernumbers;
713 =head3 ModBasketUsers
715 my @basketusers_ids = (1, 2, 3);
716 &ModBasketUsers($basketno, @basketusers_ids);
718 Delete all users from basket users list, and add users in C<@basketusers_ids>
724 my ($basketno, @basketusers_ids) = @_;
726 return unless $basketno;
728 my $dbh = C4
::Context
->dbh;
730 DELETE FROM aqbasketusers
733 my $sth = $dbh->prepare($query);
734 $sth->execute($basketno);
737 INSERT INTO aqbasketusers
(basketno
, borrowernumber
)
740 $sth = $dbh->prepare($query);
741 foreach my $basketuser_id (@basketusers_ids) {
742 $sth->execute($basketno, $basketuser_id);
747 =head3 CanUserManageBasket
749 my $bool = CanUserManageBasket($borrower, $basket[, $userflags]);
750 my $bool = CanUserManageBasket($borrowernumber, $basketno[, $userflags]);
752 Check if a borrower can manage a basket, according to system preference
753 AcqViewBaskets, user permissions and basket properties (creator, users list,
756 First parameter can be either a borrowernumber or a hashref as returned by
757 C4::Members::GetMember.
759 Second parameter can be either a basketno or a hashref as returned by
760 C4::Acquisition::GetBasket.
762 The third parameter is optional. If given, it should be a hashref as returned
763 by C4::Auth::getuserflags. If not, getuserflags is called.
765 If user is authorised to manage basket, returns 1.
770 sub CanUserManageBasket
{
771 my ($borrower, $basket, $userflags) = @_;
773 if (!ref $borrower) {
774 $borrower = C4
::Members
::GetMember
(borrowernumber
=> $borrower);
777 $basket = GetBasket
($basket);
780 return 0 unless ($basket and $borrower);
782 my $borrowernumber = $borrower->{borrowernumber
};
783 my $basketno = $basket->{basketno
};
785 my $AcqViewBaskets = C4
::Context
->preference('AcqViewBaskets');
787 if (!defined $userflags) {
788 my $dbh = C4
::Context
->dbh;
789 my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE borrowernumber = ?");
790 $sth->execute($borrowernumber);
791 my ($flags) = $sth->fetchrow_array;
794 $userflags = C4
::Auth
::getuserflags
($flags, $borrower->{userid
}, $dbh);
797 unless ($userflags->{superlibrarian
}
798 || (ref $userflags->{acquisition
} && $userflags->{acquisition
}->{order_manage_all
})
799 || (!ref $userflags->{acquisition
} && $userflags->{acquisition
}))
801 if (not exists $userflags->{acquisition
}) {
805 if ( (ref $userflags->{acquisition
} && !$userflags->{acquisition
}->{order_manage
})
806 || (!ref $userflags->{acquisition
} && !$userflags->{acquisition
}) ) {
810 if ($AcqViewBaskets eq 'user'
811 && $basket->{authorisedby
} != $borrowernumber
812 && grep($borrowernumber, GetBasketUsers
($basketno)) == 0) {
816 if ($AcqViewBaskets eq 'branch' && defined $basket->{branch
}
817 && $basket->{branch
} ne $borrower->{branchcode
}) {
825 #------------------------------------------------------------#
827 =head3 GetBasketsByBasketgroup
829 $baskets = &GetBasketsByBasketgroup($basketgroupid);
831 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
835 sub GetBasketsByBasketgroup
{
836 my $basketgroupid = shift;
838 SELECT
*, aqbasket
.booksellerid as booksellerid
840 LEFT JOIN aqcontract USING
(contractnumber
) WHERE basketgroupid
=?
842 my $dbh = C4
::Context
->dbh;
843 my $sth = $dbh->prepare($query);
844 $sth->execute($basketgroupid);
845 return $sth->fetchall_arrayref({});
848 #------------------------------------------------------------#
850 =head3 NewBasketgroup
852 $basketgroupid = NewBasketgroup(\%hashref);
854 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
856 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
858 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
860 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
862 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
864 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
866 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
868 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
870 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
875 my $basketgroupinfo = shift;
876 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
877 my $query = "INSERT INTO aqbasketgroups (";
879 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
880 if ( defined $basketgroupinfo->{$field} ) {
881 $query .= "$field, ";
882 push(@params, $basketgroupinfo->{$field});
885 $query .= "booksellerid) VALUES (";
890 push(@params, $basketgroupinfo->{'booksellerid'});
891 my $dbh = C4
::Context
->dbh;
892 my $sth = $dbh->prepare($query);
893 $sth->execute(@params);
894 my $basketgroupid = $dbh->{'mysql_insertid'};
895 if( $basketgroupinfo->{'basketlist'} ) {
896 foreach my $basketno (@
{$basketgroupinfo->{'basketlist'}}) {
897 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
898 my $sth2 = $dbh->prepare($query2);
899 $sth2->execute($basketgroupid, $basketno);
902 return $basketgroupid;
905 #------------------------------------------------------------#
907 =head3 ModBasketgroup
909 ModBasketgroup(\%hashref);
911 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
913 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
915 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
917 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
919 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
921 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
923 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
925 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
927 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
932 my $basketgroupinfo = shift;
933 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
934 my $dbh = C4
::Context
->dbh;
935 my $query = "UPDATE aqbasketgroups SET ";
937 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
938 if ( defined $basketgroupinfo->{$field} ) {
939 $query .= "$field=?, ";
940 push(@params, $basketgroupinfo->{$field});
945 $query .= " WHERE id=?";
946 push(@params, $basketgroupinfo->{'id'});
947 my $sth = $dbh->prepare($query);
948 $sth->execute(@params);
950 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
951 $sth->execute($basketgroupinfo->{'id'});
953 if($basketgroupinfo->{'basketlist'} && @
{$basketgroupinfo->{'basketlist'}}){
954 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
955 foreach my $basketno (@
{$basketgroupinfo->{'basketlist'}}) {
956 $sth->execute($basketgroupinfo->{'id'}, $basketno);
962 #------------------------------------------------------------#
964 =head3 DelBasketgroup
966 DelBasketgroup($basketgroupid);
968 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
972 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
979 my $basketgroupid = shift;
980 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
981 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
982 my $dbh = C4
::Context
->dbh;
983 my $sth = $dbh->prepare($query);
984 $sth->execute($basketgroupid);
988 #------------------------------------------------------------#
991 =head2 FUNCTIONS ABOUT ORDERS
993 =head3 GetBasketgroup
995 $basketgroup = &GetBasketgroup($basketgroupid);
997 Returns a reference to the hash containing all information about the basketgroup.
1001 sub GetBasketgroup
{
1002 my $basketgroupid = shift;
1003 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1004 my $dbh = C4
::Context
->dbh;
1005 my $result_set = $dbh->selectall_arrayref(
1006 'SELECT * FROM aqbasketgroups WHERE id=?',
1010 return $result_set->[0]; # id is unique
1013 #------------------------------------------------------------#
1015 =head3 GetBasketgroups
1017 $basketgroups = &GetBasketgroups($booksellerid);
1019 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
1023 sub GetBasketgroups
{
1024 my $booksellerid = shift;
1025 die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
1026 my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
1027 my $dbh = C4
::Context
->dbh;
1028 my $sth = $dbh->prepare($query);
1029 $sth->execute($booksellerid);
1030 return $sth->fetchall_arrayref({});
1033 #------------------------------------------------------------#
1035 =head2 FUNCTIONS ABOUT ORDERS
1039 @orders = &GetOrders($basketnumber, $orderby);
1041 Looks up the pending (non-cancelled) orders with the given basket
1042 number. If C<$booksellerID> is non-empty, only orders from that seller
1046 C<&basket> returns a two-element array. C<@orders> is an array of
1047 references-to-hash, whose keys are the fields from the aqorders,
1048 biblio, and biblioitems tables in the Koha database.
1053 my ( $basketno, $orderby ) = @_;
1054 return () unless $basketno;
1055 my $dbh = C4
::Context
->dbh;
1057 SELECT biblio.*,biblioitems.*,
1060 aqorders_transfers.ordernumber_from AS transferred_from,
1061 aqorders_transfers.timestamp AS transferred_from_timestamp
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 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1068 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
1071 $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
1072 $query .= " ORDER BY $orderby";
1074 $dbh->selectall_arrayref( $query, { Slice
=> {} }, $basketno );
1075 return @
{$result_set};
1079 #------------------------------------------------------------#
1080 =head3 GetOrdersByBiblionumber
1082 @orders = &GetOrdersByBiblionumber($biblionumber);
1084 Looks up the orders with linked to a specific $biblionumber, including
1085 cancelled orders and received orders.
1088 C<@orders> is an array of references-to-hash, whose keys are the
1089 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
1093 sub GetOrdersByBiblionumber
{
1094 my $biblionumber = shift;
1095 return unless $biblionumber;
1096 my $dbh = C4
::Context
->dbh;
1098 SELECT biblio.*,biblioitems.*,
1102 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1103 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1104 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1105 WHERE aqorders.biblionumber=?
1108 $dbh->selectall_arrayref( $query, { Slice
=> {} }, $biblionumber );
1109 return @
{$result_set};
1113 #------------------------------------------------------------#
1117 $order = &GetOrder($ordernumber);
1119 Looks up an order by order number.
1121 Returns a reference-to-hash describing the order. The keys of
1122 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1127 my ($ordernumber) = @_;
1128 return unless $ordernumber;
1130 my $dbh = C4
::Context
->dbh;
1131 my $query = qq{SELECT
1135 aqbasket
.basketname
,
1136 borrowers
.branchcode
,
1137 biblioitems
.publicationyear
,
1138 biblio
.copyrightdate
,
1139 biblioitems
.editionstatement
,
1143 biblioitems
.publishercode
,
1144 aqorders
.rrp AS unitpricesupplier
,
1145 aqorders
.ecost AS unitpricelib
,
1146 aqorders
.claims_count AS claims_count
,
1147 aqorders
.claimed_date AS claimed_date
,
1148 aqbudgets
.budget_name AS budget
,
1149 aqbooksellers
.name AS supplier
,
1150 aqbooksellers
.id AS supplierid
,
1151 biblioitems
.publishercode AS publisher
,
1152 ADDDATE
(aqbasket
.closedate
, INTERVAL aqbooksellers
.deliverytime DAY
) AS estimateddeliverydate
,
1153 DATE
(aqbasket
.closedate
) AS orderdate
,
1154 aqorders
.quantity
- COALESCE
(aqorders
.quantityreceived
,0) AS quantity_to_receive
,
1155 (aqorders
.quantity
- COALESCE
(aqorders
.quantityreceived
,0)) * aqorders
.rrp AS subtotal
,
1156 DATEDIFF
(CURDATE
( ),closedate
) AS latesince
1157 FROM aqorders LEFT JOIN biblio ON biblio
.biblionumber
= aqorders
.biblionumber
1158 LEFT JOIN biblioitems ON biblioitems
.biblionumber
= biblio
.biblionumber
1159 LEFT JOIN aqbudgets ON aqorders
.budget_id
= aqbudgets
.budget_id
,
1160 aqbasket LEFT JOIN borrowers ON aqbasket
.authorisedby
= borrowers
.borrowernumber
1161 LEFT JOIN aqbooksellers ON aqbasket
.booksellerid
= aqbooksellers
.id
1162 WHERE aqorders
.basketno
= aqbasket
.basketno
1165 $dbh->selectall_arrayref( $query, { Slice
=> {} }, $ordernumber );
1167 # result_set assumed to contain 1 match
1168 return $result_set->[0];
1171 =head3 GetLastOrderNotReceivedFromSubscriptionid
1173 $order = &GetLastOrderNotReceivedFromSubscriptionid($subscriptionid);
1175 Returns a reference-to-hash describing the last order not received for a subscription.
1179 sub GetLastOrderNotReceivedFromSubscriptionid
{
1180 my ( $subscriptionid ) = @_;
1181 my $dbh = C4
::Context
->dbh;
1183 SELECT
* FROM aqorders
1184 LEFT JOIN subscription
1185 ON
( aqorders
.subscriptionid
= subscription
.subscriptionid
)
1186 WHERE aqorders
.subscriptionid
= ?
1187 AND aqorders
.datereceived IS NULL
1191 $dbh->selectall_arrayref( $query, { Slice
=> {} }, $subscriptionid );
1193 # result_set assumed to contain 1 match
1194 return $result_set->[0];
1197 =head3 GetLastOrderReceivedFromSubscriptionid
1199 $order = &GetLastOrderReceivedFromSubscriptionid($subscriptionid);
1201 Returns a reference-to-hash describing the last order received for a subscription.
1205 sub GetLastOrderReceivedFromSubscriptionid
{
1206 my ( $subscriptionid ) = @_;
1207 my $dbh = C4
::Context
->dbh;
1209 SELECT
* FROM aqorders
1210 LEFT JOIN subscription
1211 ON
( aqorders
.subscriptionid
= subscription
.subscriptionid
)
1212 WHERE aqorders
.subscriptionid
= ?
1213 AND aqorders
.datereceived
=
1215 SELECT MAX
( aqorders
.datereceived
)
1217 LEFT JOIN subscription
1218 ON
( aqorders
.subscriptionid
= subscription
.subscriptionid
)
1219 WHERE aqorders
.subscriptionid
= ?
1220 AND aqorders
.datereceived IS NOT NULL
1222 ORDER BY ordernumber DESC
1226 $dbh->selectall_arrayref( $query, { Slice
=> {} }, $subscriptionid, $subscriptionid );
1228 # result_set assumed to contain 1 match
1229 return $result_set->[0];
1233 #------------------------------------------------------------#
1237 &ModOrder(\%hashref);
1239 Modifies an existing order. Updates the order with order number
1240 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1241 other keys of the hash update the fields with the same name in the aqorders
1242 table of the Koha database.
1247 my $orderinfo = shift;
1249 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '' ;
1250 die "Biblionumber is required" if $orderinfo->{'biblionumber'} eq '';
1252 my $dbh = C4
::Context
->dbh;
1255 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1256 $orderinfo->{uncertainprice
}=1 if $orderinfo->{uncertainprice
};
1258 # delete($orderinfo->{'branchcode'});
1259 # the hash contains a lot of entries not in aqorders, so get the columns ...
1260 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1262 my $colnames = $sth->{NAME
};
1263 #FIXME Be careful. If aqorders would have columns with diacritics,
1264 #you should need to decode what you get back from NAME.
1265 #See report 10110 and guided_reports.pl
1266 my $query = "UPDATE aqorders SET ";
1268 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1269 # ... and skip hash entries that are not in the aqorders table
1270 # FIXME : probably not the best way to do it (would be better to have a correct hash)
1271 next unless grep(/^$orderinfokey$/, @
$colnames);
1272 $query .= "$orderinfokey=?, ";
1273 push(@params, $orderinfo->{$orderinfokey});
1276 $query .= "timestamp=NOW() WHERE ordernumber=?";
1277 push(@params, $orderinfo->{'ordernumber'} );
1278 $sth = $dbh->prepare($query);
1279 $sth->execute(@params);
1283 #------------------------------------------------------------#
1287 ModItemOrder($itemnumber, $ordernumber);
1289 Modifies the ordernumber of an item in aqorders_items.
1294 my ($itemnumber, $ordernumber) = @_;
1296 return unless ($itemnumber and $ordernumber);
1298 my $dbh = C4
::Context
->dbh;
1300 UPDATE aqorders_items
1302 WHERE itemnumber
= ?
1304 my $sth = $dbh->prepare($query);
1305 return $sth->execute($ordernumber, $itemnumber);
1308 #------------------------------------------------------------#
1310 =head3 GetCancelledOrders
1312 my @orders = GetCancelledOrders($basketno, $orderby);
1314 Returns cancelled orders for a basket
1318 sub GetCancelledOrders
{
1319 my ( $basketno, $orderby ) = @_;
1321 return () unless $basketno;
1323 my $dbh = C4
::Context
->dbh;
1330 aqorders_transfers.ordernumber_to AS transferred_to,
1331 aqorders_transfers.timestamp AS transferred_to_timestamp
1333 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1334 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1335 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1336 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
1338 AND (datecancellationprinted IS NOT NULL
1339 AND datecancellationprinted <> '0000-00-00')
1342 $orderby = "aqorders.datecancellationprinted desc, aqorders.timestamp desc"
1344 $query .= " ORDER BY $orderby";
1345 my $sth = $dbh->prepare($query);
1346 $sth->execute($basketno);
1347 my $results = $sth->fetchall_arrayref( {} );
1353 #------------------------------------------------------------#
1355 =head3 ModReceiveOrder
1358 biblionumber => $biblionumber,
1359 ordernumber => $ordernumber,
1360 quantityreceived => $quantityreceived,
1364 invoiceid => $invoiceid,
1366 budget_id => $budget_id,
1367 datereceived => $datereceived,
1368 received_itemnumbers => \@received_itemnumbers,
1369 order_internalnote => $order_internalnote,
1370 order_vendornote => $order_vendornote,
1373 Updates an order, to reflect the fact that it was received, at least
1374 in part. All arguments not mentioned below update the fields with the
1375 same name in the aqorders table of the Koha database.
1377 If a partial order is received, splits the order into two.
1379 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1385 sub ModReceiveOrder
{
1386 my ( $params ) = @_;
1387 my $biblionumber = $params->{biblionumber
};
1388 my $ordernumber = $params->{ordernumber
};
1389 my $quantrec = $params->{quantityreceived
};
1390 my $user = $params->{user
};
1391 my $cost = $params->{cost
};
1392 my $ecost = $params->{ecost
};
1393 my $invoiceid = $params->{invoiceid
};
1394 my $rrp = $params->{rrp
};
1395 my $budget_id = $params->{budget_id
};
1396 my $datereceived = $params->{datereceived
};
1397 my $received_items = $params->{received_items
};
1398 my $order_internalnote = $params->{order_internalnote
};
1399 my $order_vendornote = $params->{order_vendornote
};
1401 my $dbh = C4
::Context
->dbh;
1402 $datereceived = C4
::Dates
->output('iso') unless $datereceived;
1403 my $suggestionid = GetSuggestionFromBiblionumber
( $biblionumber );
1404 if ($suggestionid) {
1405 ModSuggestion
( {suggestionid
=>$suggestionid,
1406 STATUS
=>'AVAILABLE',
1407 biblionumber
=> $biblionumber}
1411 my $result_set = $dbh->selectall_arrayref(
1412 q{SELECT * FROM aqorders WHERE biblionumber=? AND aqorders.ordernumber=?},
1413 { Slice
=> {} }, $biblionumber, $ordernumber
1416 # we assume we have a unique order
1417 my $order = $result_set->[0];
1419 my $new_ordernumber = $ordernumber;
1420 if ( $order->{quantity
} > $quantrec ) {
1421 # Split order line in two parts: the first is the original order line
1422 # without received items (the quantity is decreased),
1423 # the second part is a new order line with quantity=quantityrec
1424 # (entirely received)
1428 orderstatus
= 'partial'|;
1429 $query .= q
|, order_internalnote
= ?
| if defined $order_internalnote;
1430 $query .= q
|, order_vendornote
= ?
| if defined $order_vendornote;
1431 $query .= q
| WHERE ordernumber
= ?
|;
1432 my $sth = $dbh->prepare($query);
1435 $order->{quantity
} - $quantrec,
1436 ( defined $order_internalnote ?
$order_internalnote : () ),
1437 ( defined $order_vendornote ?
$order_vendornote : () ),
1441 delete $order->{'ordernumber'};
1442 $order->{'budget_id'} = ( $budget_id || $order->{'budget_id'} );
1443 $order->{'quantity'} = $quantrec;
1444 $order->{'quantityreceived'} = $quantrec;
1445 $order->{'datereceived'} = $datereceived;
1446 $order->{'invoiceid'} = $invoiceid;
1447 $order->{'unitprice'} = $cost;
1448 $order->{'rrp'} = $rrp;
1449 $order->{ecost
} = $ecost;
1450 $order->{'orderstatus'} = 'complete';
1451 $new_ordernumber = Koha
::Acquisition
::Order
->new($order)->insert->{ordernumber
};
1453 if ($received_items) {
1454 foreach my $itemnumber (@
$received_items) {
1455 ModItemOrder
($itemnumber, $new_ordernumber);
1461 set quantityreceived
=?
,datereceived
=?
,invoiceid
=?
,
1462 unitprice
=?
,rrp
=?
,ecost
=?
,budget_id
=?
,orderstatus
='complete'|;
1463 $query .= q
|, order_internalnote
= ?
| if defined $order_internalnote;
1464 $query .= q
|, order_vendornote
= ?
| if defined $order_vendornote;
1465 $query .= q
| where biblionumber
=?
and ordernumber
=?
|;
1466 my $sth = $dbh->prepare( $query );
1475 ( defined $order_internalnote ?
$order_internalnote : () ),
1476 ( defined $order_vendornote ?
$order_vendornote : () ),
1481 return ($datereceived, $new_ordernumber);
1484 =head3 CancelReceipt
1486 my $parent_ordernumber = CancelReceipt($ordernumber);
1488 Cancel an order line receipt and update the parent order line, as if no
1490 If items are created at receipt (AcqCreateItem = receiving) then delete
1496 my $ordernumber = shift;
1498 return unless $ordernumber;
1500 my $dbh = C4
::Context
->dbh;
1502 SELECT datereceived
, parent_ordernumber
, quantity
1504 WHERE ordernumber
= ?
1506 my $sth = $dbh->prepare($query);
1507 $sth->execute($ordernumber);
1508 my $order = $sth->fetchrow_hashref;
1510 warn "CancelReceipt: order $ordernumber does not exist";
1513 unless($order->{'datereceived'}) {
1514 warn "CancelReceipt: order $ordernumber is not received";
1518 my $parent_ordernumber = $order->{'parent_ordernumber'};
1520 my @itemnumbers = GetItemnumbersFromOrder
( $ordernumber );
1522 if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1523 # The order line has no parent, just mark it as not received
1526 SET quantityreceived
= ?
,
1529 orderstatus
= 'ordered'
1530 WHERE ordernumber
= ?
1532 $sth = $dbh->prepare($query);
1533 $sth->execute(0, undef, undef, $ordernumber);
1534 _cancel_items_receipt
( $ordernumber );
1536 # The order line has a parent, increase parent quantity and delete
1539 SELECT quantity
, datereceived
1541 WHERE ordernumber
= ?
1543 $sth = $dbh->prepare($query);
1544 $sth->execute($parent_ordernumber);
1545 my $parent_order = $sth->fetchrow_hashref;
1546 unless($parent_order) {
1547 warn "Parent order $parent_ordernumber does not exist.";
1550 if($parent_order->{'datereceived'}) {
1551 warn "CancelReceipt: parent order is received.".
1552 " Can't cancel receipt.";
1558 orderstatus
= 'ordered'
1559 WHERE ordernumber
= ?
1561 $sth = $dbh->prepare($query);
1562 my $rv = $sth->execute(
1563 $order->{'quantity'} + $parent_order->{'quantity'},
1567 warn "Cannot update parent order line, so do not cancel".
1571 _cancel_items_receipt
( $ordernumber, $parent_ordernumber );
1574 DELETE FROM aqorders
1575 WHERE ordernumber
= ?
1577 $sth = $dbh->prepare($query);
1578 $sth->execute($ordernumber);
1582 if(C4
::Context
->preference('AcqCreateItem') eq 'ordering') {
1583 my @affects = split q{\|}, C4
::Context
->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1585 for my $in ( @itemnumbers ) {
1586 my $biblionumber = C4
::Biblio
::GetBiblionumberFromItemnumber
( $in );
1587 my $frameworkcode = GetFrameworkCode
($biblionumber);
1588 my ( $itemfield ) = GetMarcFromKohaField
( 'items.itemnumber', $frameworkcode );
1589 my $item = C4
::Items
::GetMarcItem
( $biblionumber, $in );
1590 for my $affect ( @affects ) {
1591 my ( $sf, $v ) = split q{=}, $affect, 2;
1592 foreach ( $item->field($itemfield) ) {
1593 $_->update( $sf => $v );
1596 C4
::Items
::ModItemFromMarc
( $item, $biblionumber, $in );
1601 return $parent_ordernumber;
1604 sub _cancel_items_receipt
{
1605 my ( $ordernumber, $parent_ordernumber ) = @_;
1606 $parent_ordernumber ||= $ordernumber;
1608 my @itemnumbers = GetItemnumbersFromOrder
($ordernumber);
1609 if(C4
::Context
->preference('AcqCreateItem') eq 'receiving') {
1610 # Remove items that were created at receipt
1612 DELETE FROM items
, aqorders_items
1613 USING items
, aqorders_items
1614 WHERE items
.itemnumber
= ? AND aqorders_items
.itemnumber
= ?
1616 my $dbh = C4
::Context
->dbh;
1617 my $sth = $dbh->prepare($query);
1618 foreach my $itemnumber (@itemnumbers) {
1619 $sth->execute($itemnumber, $itemnumber);
1623 foreach my $itemnumber (@itemnumbers) {
1624 ModItemOrder
($itemnumber, $parent_ordernumber);
1629 #------------------------------------------------------------#
1633 @results = &SearchOrders({
1634 ordernumber => $ordernumber,
1636 biblionumber => $biblionumber,
1638 booksellerid => $booksellerid,
1639 basketno => $basketno,
1645 Searches for orders.
1647 C<$owner> Finds order for the logged in user.
1648 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1649 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1652 C<@results> is an array of references-to-hash with the keys are fields
1653 from aqorders, biblio, biblioitems and aqbasket tables.
1658 my ( $params ) = @_;
1659 my $ordernumber = $params->{ordernumber
};
1660 my $search = $params->{search
};
1661 my $ean = $params->{ean
};
1662 my $booksellerid = $params->{booksellerid
};
1663 my $basketno = $params->{basketno
};
1664 my $basketname = $params->{basketname
};
1665 my $basketgroupname = $params->{basketgroupname
};
1666 my $owner = $params->{owner
};
1667 my $pending = $params->{pending
};
1668 my $ordered = $params->{ordered
};
1669 my $biblionumber = $params->{biblionumber
};
1670 my $budget_id = $params->{budget_id
};
1672 my $dbh = C4
::Context
->dbh;
1675 SELECT aqbasket.basketno,
1677 borrowers.firstname,
1680 biblioitems.biblioitemnumber,
1681 aqbasket.authorisedby,
1682 aqbasket.booksellerid,
1684 aqbasket.creationdate,
1685 aqbasket.basketname,
1686 aqbasketgroups.id as basketgroupid,
1687 aqbasketgroups.name as basketgroupname,
1690 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1691 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1692 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1693 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1694 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1697 # If we search on ordernumber, we retrieve the transfered order if a transfer has been done.
1699 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1703 WHERE (datecancellationprinted is NULL)
1706 if ( $pending or $ordered ) {
1707 $query .= q{ AND (quantity > quantityreceived OR quantityreceived is NULL)};
1710 $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1713 my $userenv = C4
::Context
->userenv;
1714 if ( C4
::Context
->preference("IndependentBranches") ) {
1715 unless ( C4
::Context
->IsSuperLibrarian() ) {
1718 borrowers.branchcode = ?
1719 OR borrowers.branchcode = ''
1722 push @args, $userenv->{branch
};
1726 if ( $ordernumber ) {
1727 $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1728 push @args, ( $ordernumber, $ordernumber );
1730 if ( $biblionumber ) {
1731 $query .= 'AND aqorders.biblionumber = ?';
1732 push @args, $biblionumber;
1735 $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1736 push @args, ("%$search%","%$search%","%$search%");
1739 $query .= ' AND biblioitems.ean = ?';
1742 if ( $booksellerid ) {
1743 $query .= 'AND aqbasket.booksellerid = ?';
1744 push @args, $booksellerid;
1747 $query .= 'AND aqbasket.basketno = ?';
1748 push @args, $basketno;
1751 $query .= 'AND aqbasket.basketname LIKE ?';
1752 push @args, "%$basketname%";
1754 if( $basketgroupname ) {
1755 $query .= ' AND aqbasketgroups.name LIKE ?';
1756 push @args, "%$basketgroupname%";
1760 $query .= ' AND aqbasket.authorisedby=? ';
1761 push @args, $userenv->{'number'};
1765 $query .= ' AND aqorders.budget_id = ?';
1766 push @args, $budget_id;
1769 $query .= ' ORDER BY aqbasket.basketno';
1771 my $sth = $dbh->prepare($query);
1772 $sth->execute(@args);
1773 return $sth->fetchall_arrayref({});
1776 #------------------------------------------------------------#
1780 &DelOrder($biblionumber, $ordernumber);
1782 Cancel the order with the given order and biblio numbers. It does not
1783 delete any entries in the aqorders table, it merely marks them as
1789 my ( $bibnum, $ordernumber, $delete_biblio, $reason ) = @_;
1792 my $dbh = C4
::Context
->dbh;
1795 SET datecancellationprinted=now(), orderstatus='cancelled'
1798 $query .= ", cancellationreason = ? ";
1801 WHERE biblionumber=? AND ordernumber=?
1803 my $sth = $dbh->prepare($query);
1805 $sth->execute($reason, $bibnum, $ordernumber);
1807 $sth->execute( $bibnum, $ordernumber );
1811 my @itemnumbers = GetItemnumbersFromOrder
( $ordernumber );
1812 foreach my $itemnumber (@itemnumbers){
1813 my $delcheck = C4
::Items
::DelItemCheck
( $dbh, $bibnum, $itemnumber );
1815 if($delcheck != 1) {
1816 $error->{'delitem'} = 1;
1820 if($delete_biblio) {
1821 # We get the number of remaining items
1822 my $itemcount = C4
::Items
::GetItemsCount
($bibnum);
1824 # If there are no items left,
1825 if ( $itemcount == 0 ) {
1826 # We delete the record
1827 my $delcheck = DelBiblio
($bibnum);
1830 $error->{'delbiblio'} = 1;
1838 =head3 TransferOrder
1840 my $newordernumber = TransferOrder($ordernumber, $basketno);
1842 Transfer an order line to a basket.
1843 Mark $ordernumber as cancelled with an internal note 'Cancelled and transfered
1844 to BOOKSELLER on DATE' and create new order with internal note
1845 'Transfered from BOOKSELLER on DATE'.
1846 Move all attached items to the new order.
1847 Received orders cannot be transfered.
1848 Return the ordernumber of created order.
1853 my ($ordernumber, $basketno) = @_;
1855 return unless ($ordernumber and $basketno);
1857 my $order = GetOrder
( $ordernumber );
1858 return if $order->{datereceived
};
1859 my $basket = GetBasket
($basketno);
1860 return unless $basket;
1862 my $dbh = C4
::Context
->dbh;
1863 my ($query, $sth, $rv);
1867 SET datecancellationprinted = CAST(NOW() AS date)
1868 WHERE ordernumber = ?
1870 $sth = $dbh->prepare($query);
1871 $rv = $sth->execute($ordernumber);
1873 delete $order->{'ordernumber'};
1874 delete $order->{parent_ordernumber
};
1875 $order->{'basketno'} = $basketno;
1877 my $newordernumber = Koha
::Acquisition
::Order
->new($order)->insert->{ordernumber
};
1880 UPDATE aqorders_items
1882 WHERE ordernumber = ?
1884 $sth = $dbh->prepare($query);
1885 $sth->execute($newordernumber, $ordernumber);
1888 INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1891 $sth = $dbh->prepare($query);
1892 $sth->execute($ordernumber, $newordernumber);
1894 return $newordernumber;
1897 =head2 FUNCTIONS ABOUT PARCELS
1901 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1903 get a lists of parcels.
1910 is the bookseller this function has to get parcels.
1913 To know on what criteria the results list has to be ordered.
1916 is the booksellerinvoicenumber.
1918 =item $datefrom & $dateto
1919 to know on what date this function has to filter its search.
1924 a pointer on a hash list containing parcel informations as such :
1930 =item Last operation
1932 =item Number of biblio
1934 =item Number of items
1941 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1942 my $dbh = C4
::Context
->dbh;
1943 my @query_params = ();
1945 SELECT aqinvoices.invoicenumber,
1946 datereceived,purchaseordernumber,
1947 count(DISTINCT biblionumber) AS biblio,
1948 sum(quantity) AS itemsexpected,
1949 sum(quantityreceived) AS itemsreceived
1950 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1951 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1952 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1954 push @query_params, $bookseller;
1956 if ( defined $code ) {
1957 $strsth .= ' and aqinvoices.invoicenumber like ? ';
1958 # add a % to the end of the code to allow stemming.
1959 push @query_params, "$code%";
1962 if ( defined $datefrom ) {
1963 $strsth .= ' and datereceived >= ? ';
1964 push @query_params, $datefrom;
1967 if ( defined $dateto ) {
1968 $strsth .= 'and datereceived <= ? ';
1969 push @query_params, $dateto;
1972 $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
1974 # can't use a placeholder to place this column name.
1975 # but, we could probably be checking to make sure it is a column that will be fetched.
1976 $strsth .= "order by $order " if ($order);
1978 my $sth = $dbh->prepare($strsth);
1980 $sth->execute( @query_params );
1981 my $results = $sth->fetchall_arrayref({});
1985 #------------------------------------------------------------#
1987 =head3 GetLateOrders
1989 @results = &GetLateOrders;
1991 Searches for bookseller with late orders.
1994 the table of supplier with late issues. This table is full of hashref.
2000 my $supplierid = shift;
2002 my $estimateddeliverydatefrom = shift;
2003 my $estimateddeliverydateto = shift;
2005 my $dbh = C4
::Context
->dbh;
2007 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
2008 my $dbdriver = C4
::Context
->config("db_scheme") || "mysql";
2010 my @query_params = ();
2012 SELECT aqbasket.basketno,
2013 aqorders.ordernumber,
2014 DATE(aqbasket.closedate) AS orderdate,
2015 aqbasket.basketname AS basketname,
2016 aqbasket.basketgroupid AS basketgroupid,
2017 aqbasketgroups.name AS basketgroupname,
2018 aqorders.rrp AS unitpricesupplier,
2019 aqorders.ecost AS unitpricelib,
2020 aqorders.claims_count AS claims_count,
2021 aqorders.claimed_date AS claimed_date,
2022 aqbudgets.budget_name AS budget,
2023 borrowers.branchcode AS branch,
2024 aqbooksellers.name AS supplier,
2025 aqbooksellers.id AS supplierid,
2026 biblio.author, biblio.title,
2027 biblioitems.publishercode AS publisher,
2028 biblioitems.publicationyear,
2029 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
2033 aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
2034 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
2035 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
2036 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
2037 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
2038 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2039 WHERE aqorders.basketno = aqbasket.basketno
2040 AND ( datereceived = ''
2041 OR datereceived IS NULL
2042 OR aqorders.quantityreceived < aqorders.quantity
2044 AND aqbasket.closedate IS NOT NULL
2045 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
2048 if ($dbdriver eq "mysql") {
2050 aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity,
2051 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
2052 DATEDIFF(CAST(now() AS date),closedate) AS latesince
2054 if ( defined $delay ) {
2055 $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
2056 push @query_params, $delay;
2059 HAVING quantity <> 0
2060 AND unitpricesupplier <> 0
2061 AND unitpricelib <> 0
2064 # FIXME: account for IFNULL as above
2066 aqorders.quantity AS quantity,
2067 aqorders.quantity * aqorders.rrp AS subtotal,
2068 (CAST(now() AS date) - closedate) AS latesince
2070 if ( defined $delay ) {
2071 $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
2072 push @query_params, $delay;
2075 if (defined $supplierid) {
2076 $from .= ' AND aqbasket.booksellerid = ? ';
2077 push @query_params, $supplierid;
2079 if (defined $branch) {
2080 $from .= ' AND borrowers.branchcode LIKE ? ';
2081 push @query_params, $branch;
2084 if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
2085 $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
2087 if ( defined $estimateddeliverydatefrom ) {
2088 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
2089 push @query_params, $estimateddeliverydatefrom;
2091 if ( defined $estimateddeliverydateto ) {
2092 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
2093 push @query_params, $estimateddeliverydateto;
2095 if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
2096 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
2098 if (C4
::Context
->preference("IndependentBranches")
2099 && !C4
::Context
->IsSuperLibrarian() ) {
2100 $from .= ' AND borrowers.branchcode LIKE ? ';
2101 push @query_params, C4
::Context
->userenv->{branch
};
2103 $from .= " AND orderstatus <> 'cancelled' ";
2104 my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
2105 $debug and print STDERR
"GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
2106 my $sth = $dbh->prepare($query);
2107 $sth->execute(@query_params);
2109 while (my $data = $sth->fetchrow_hashref) {
2110 push @results, $data;
2115 #------------------------------------------------------------#
2119 \@order_loop = GetHistory( %params );
2121 Retreives some acquisition history information
2131 basket - search both basket name and number
2132 booksellerinvoicenumber
2135 orderstatus (note that orderstatus '' will retrieve orders
2136 of any status except cancelled)
2138 get_canceled_order (if set to a true value, cancelled orders will
2142 $order_loop is a list of hashrefs that each look like this:
2144 'author' => 'Twain, Mark',
2146 'biblionumber' => '215',
2148 'creationdate' => 'MM/DD/YYYY',
2149 'datereceived' => undef,
2152 'invoicenumber' => undef,
2154 'ordernumber' => '1',
2156 'quantityreceived' => undef,
2157 'title' => 'The Adventures of Huckleberry Finn'
2163 # don't run the query if there are no parameters (list would be too long for sure !)
2164 croak
"No search params" unless @_;
2166 my $title = $params{title
};
2167 my $author = $params{author
};
2168 my $isbn = $params{isbn
};
2169 my $ean = $params{ean
};
2170 my $name = $params{name
};
2171 my $from_placed_on = $params{from_placed_on
};
2172 my $to_placed_on = $params{to_placed_on
};
2173 my $basket = $params{basket
};
2174 my $booksellerinvoicenumber = $params{booksellerinvoicenumber
};
2175 my $basketgroupname = $params{basketgroupname
};
2176 my $budget = $params{budget
};
2177 my $orderstatus = $params{orderstatus
};
2178 my $biblionumber = $params{biblionumber
};
2179 my $get_canceled_order = $params{get_canceled_order
} || 0;
2180 my $ordernumber = $params{ordernumber
};
2181 my $search_children_too = $params{search_children_too
} || 0;
2185 my $total_qtyreceived = 0;
2186 my $total_price = 0;
2188 my $dbh = C4
::Context
->dbh;
2191 COALESCE(biblio.title, deletedbiblio.title) AS title,
2192 COALESCE(biblio.author, deletedbiblio.author) AS author,
2193 COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2194 COALESCE(biblioitems.ean, deletedbiblioitems.ean) AS ean,
2196 aqbasket.basketname,
2197 aqbasket.basketgroupid,
2198 aqbasketgroups.name as groupname,
2200 aqbasket.creationdate,
2201 aqorders.datereceived,
2203 aqorders.quantityreceived,
2205 aqorders.ordernumber,
2207 aqinvoices.invoicenumber,
2208 aqbooksellers.id as id,
2209 aqorders.biblionumber,
2210 aqorders.orderstatus,
2211 aqorders.parent_ordernumber,
2212 aqbudgets.budget_name
2214 $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2217 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2218 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2219 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2220 LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2221 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2222 LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2223 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2224 LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2225 LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2228 if ( C4
::Context
->preference("IndependentBranches") ) {
2229 $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber";
2232 $query .= " WHERE 1 ";
2234 unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2235 $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2238 my @query_params = ();
2240 if ( $biblionumber ) {
2241 $query .= " AND biblio.biblionumber = ?";
2242 push @query_params, $biblionumber;
2246 $query .= " AND biblio.title LIKE ? ";
2247 $title =~ s/\s+/%/g;
2248 push @query_params, "%$title%";
2252 $query .= " AND biblio.author LIKE ? ";
2253 push @query_params, "%$author%";
2257 $query .= " AND biblioitems.isbn LIKE ? ";
2258 push @query_params, "%$isbn%";
2261 $query .= " AND biblioitems.ean = ? ";
2262 push @query_params, "$ean";
2265 $query .= " AND aqbooksellers.name LIKE ? ";
2266 push @query_params, "%$name%";
2270 $query .= " AND aqbudgets.budget_id = ? ";
2271 push @query_params, "$budget";
2274 if ( $from_placed_on ) {
2275 $query .= " AND creationdate >= ? ";
2276 push @query_params, $from_placed_on;
2279 if ( $to_placed_on ) {
2280 $query .= " AND creationdate <= ? ";
2281 push @query_params, $to_placed_on;
2284 if ( defined $orderstatus and $orderstatus ne '') {
2285 $query .= " AND aqorders.orderstatus = ? ";
2286 push @query_params, "$orderstatus";
2290 if ($basket =~ m/^\d+$/) {
2291 $query .= " AND aqorders.basketno = ? ";
2292 push @query_params, $basket;
2294 $query .= " AND aqbasket.basketname LIKE ? ";
2295 push @query_params, "%$basket%";
2299 if ($booksellerinvoicenumber) {
2300 $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2301 push @query_params, "%$booksellerinvoicenumber%";
2304 if ($basketgroupname) {
2305 $query .= " AND aqbasketgroups.name LIKE ? ";
2306 push @query_params, "%$basketgroupname%";
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;
2320 if ( C4
::Context
->preference("IndependentBranches") ) {
2321 unless ( C4
::Context
->IsSuperLibrarian() ) {
2322 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2323 push @query_params, C4
::Context
->userenv->{branch
};
2326 $query .= " ORDER BY id";
2328 return $dbh->selectall_arrayref( $query, { Slice
=> {} }, @query_params );
2331 =head2 GetRecentAcqui
2333 $results = GetRecentAcqui($days);
2335 C<$results> is a ref to a table which containts hashref
2339 sub GetRecentAcqui
{
2341 my $dbh = C4
::Context
->dbh;
2345 ORDER BY timestamp DESC
2348 my $sth = $dbh->prepare($query);
2350 my $results = $sth->fetchall_arrayref({});
2354 #------------------------------------------------------------#
2360 &AddClaim($ordernumber);
2362 Add a claim for an order
2369 my ($ordernumber) = @_;
2370 my $dbh = C4
::Context
->dbh;
2373 claims_count = claims_count + 1,
2374 claimed_date = CURDATE()
2375 WHERE ordernumber = ?
2377 my $sth = $dbh->prepare($query);
2378 $sth->execute($ordernumber);
2383 my @invoices = GetInvoices(
2384 invoicenumber => $invoicenumber,
2385 supplierid => $supplierid,
2386 suppliername => $suppliername,
2387 shipmentdatefrom => $shipmentdatefrom, # ISO format
2388 shipmentdateto => $shipmentdateto, # ISO format
2389 billingdatefrom => $billingdatefrom, # ISO format
2390 billingdateto => $billingdateto, # ISO format
2391 isbneanissn => $isbn_or_ean_or_issn,
2394 publisher => $publisher,
2395 publicationyear => $publicationyear,
2396 branchcode => $branchcode,
2397 order_by => $order_by
2400 Return a list of invoices that match all given criteria.
2402 $order_by is "column_name (asc|desc)", where column_name is any of
2403 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2404 'shipmentcost', 'shipmentcost_budgetid'.
2406 asc is the default if omitted
2413 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2414 closedate shipmentcost shipmentcost_budgetid);
2416 my $dbh = C4
::Context
->dbh;
2418 SELECT aqinvoices
.*, aqbooksellers
.name AS suppliername
,
2421 aqorders
.datereceived IS NOT NULL
,
2422 aqorders
.biblionumber
,
2425 ) AS receivedbiblios
,
2428 aqorders
.subscriptionid IS NOT NULL
,
2429 aqorders
.subscriptionid
,
2432 ) AS is_linked_to_subscriptions
,
2433 SUM
(aqorders
.quantityreceived
) AS receiveditems
2435 LEFT JOIN aqbooksellers ON aqbooksellers
.id
= aqinvoices
.booksellerid
2436 LEFT JOIN aqorders ON aqorders
.invoiceid
= aqinvoices
.invoiceid
2437 LEFT JOIN aqbasket ON aqbasket
.basketno
=aqorders
.basketno
2438 LEFT JOIN borrowers ON aqbasket
.authorisedby
=borrowers
.borrowernumber
2439 LEFT JOIN biblio ON aqorders
.biblionumber
= biblio
.biblionumber
2440 LEFT JOIN biblioitems ON biblio
.biblionumber
= biblioitems
.biblionumber
2441 LEFT JOIN subscription ON biblio
.biblionumber
= subscription
.biblionumber
2446 if($args{supplierid
}) {
2447 push @bind_strs, " aqinvoices.booksellerid = ? ";
2448 push @bind_args, $args{supplierid
};
2450 if($args{invoicenumber
}) {
2451 push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2452 push @bind_args, "%$args{invoicenumber}%";
2454 if($args{suppliername
}) {
2455 push @bind_strs, " aqbooksellers.name LIKE ? ";
2456 push @bind_args, "%$args{suppliername}%";
2458 if($args{shipmentdatefrom
}) {
2459 push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2460 push @bind_args, $args{shipmentdatefrom
};
2462 if($args{shipmentdateto
}) {
2463 push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2464 push @bind_args, $args{shipmentdateto
};
2466 if($args{billingdatefrom
}) {
2467 push @bind_strs, " aqinvoices.billingdate >= ? ";
2468 push @bind_args, $args{billingdatefrom
};
2470 if($args{billingdateto
}) {
2471 push @bind_strs, " aqinvoices.billingdate <= ? ";
2472 push @bind_args, $args{billingdateto
};
2474 if($args{isbneanissn
}) {
2475 push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2476 push @bind_args, $args{isbneanissn
}, $args{isbneanissn
}, $args{isbneanissn
};
2479 push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2480 push @bind_args, $args{title
};
2483 push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2484 push @bind_args, $args{author
};
2486 if($args{publisher
}) {
2487 push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2488 push @bind_args, $args{publisher
};
2490 if($args{publicationyear
}) {
2491 push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2492 push @bind_args, $args{publicationyear
}, $args{publicationyear
};
2494 if($args{branchcode
}) {
2495 push @bind_strs, " borrowers.branchcode = ? ";
2496 push @bind_args, $args{branchcode
};
2499 $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2500 $query .= " GROUP BY aqinvoices.invoiceid ";
2502 if($args{order_by
}) {
2503 my ($column, $direction) = split / /, $args{order_by
};
2504 if(grep /^$column$/, @columns) {
2505 $direction ||= 'ASC';
2506 $query .= " ORDER BY $column $direction";
2510 my $sth = $dbh->prepare($query);
2511 $sth->execute(@bind_args);
2513 my $results = $sth->fetchall_arrayref({});
2519 my $invoice = GetInvoice($invoiceid);
2521 Get informations about invoice with given $invoiceid
2523 Return a hash filled with aqinvoices.* fields
2528 my ($invoiceid) = @_;
2531 return unless $invoiceid;
2533 my $dbh = C4
::Context
->dbh;
2539 my $sth = $dbh->prepare($query);
2540 $sth->execute($invoiceid);
2542 $invoice = $sth->fetchrow_hashref;
2546 =head3 GetInvoiceDetails
2548 my $invoice = GetInvoiceDetails($invoiceid)
2550 Return informations about an invoice + the list of related order lines
2552 Orders informations are in $invoice->{orders} (array ref)
2556 sub GetInvoiceDetails
{
2557 my ($invoiceid) = @_;
2559 if ( !defined $invoiceid ) {
2560 carp
'GetInvoiceDetails called without an invoiceid';
2564 my $dbh = C4
::Context
->dbh;
2566 SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2568 LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2571 my $sth = $dbh->prepare($query);
2572 $sth->execute($invoiceid);
2574 my $invoice = $sth->fetchrow_hashref;
2577 SELECT aqorders.*, biblio.*,
2578 biblio.copyrightdate,
2579 biblioitems.publishercode,
2580 biblioitems.publicationyear,
2583 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2584 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2585 LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2588 $sth = $dbh->prepare($query);
2589 $sth->execute($invoiceid);
2590 $invoice->{orders
} = $sth->fetchall_arrayref({});
2591 $invoice->{orders
} ||= []; # force an empty arrayref if fetchall_arrayref fails
2598 my $invoiceid = AddInvoice(
2599 invoicenumber => $invoicenumber,
2600 booksellerid => $booksellerid,
2601 shipmentdate => $shipmentdate,
2602 billingdate => $billingdate,
2603 closedate => $closedate,
2604 shipmentcost => $shipmentcost,
2605 shipmentcost_budgetid => $shipmentcost_budgetid
2608 Create a new invoice and return its id or undef if it fails.
2615 return unless(%invoice and $invoice{invoicenumber
});
2617 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2618 closedate shipmentcost shipmentcost_budgetid);
2622 foreach my $key (keys %invoice) {
2623 if(0 < grep(/^$key$/, @columns)) {
2624 push @set_strs, "$key = ?";
2625 push @set_args, ($invoice{$key} || undef);
2631 my $dbh = C4
::Context
->dbh;
2632 my $query = "INSERT INTO aqinvoices SET ";
2633 $query .= join (",", @set_strs);
2634 my $sth = $dbh->prepare($query);
2635 $rv = $sth->execute(@set_args);
2637 $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2646 invoiceid => $invoiceid, # Mandatory
2647 invoicenumber => $invoicenumber,
2648 booksellerid => $booksellerid,
2649 shipmentdate => $shipmentdate,
2650 billingdate => $billingdate,
2651 closedate => $closedate,
2652 shipmentcost => $shipmentcost,
2653 shipmentcost_budgetid => $shipmentcost_budgetid
2656 Modify an invoice, invoiceid is mandatory.
2658 Return undef if it fails.
2665 return unless(%invoice and $invoice{invoiceid
});
2667 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2668 closedate shipmentcost shipmentcost_budgetid);
2672 foreach my $key (keys %invoice) {
2673 if(0 < grep(/^$key$/, @columns)) {
2674 push @set_strs, "$key = ?";
2675 push @set_args, ($invoice{$key} || undef);
2679 my $dbh = C4
::Context
->dbh;
2680 my $query = "UPDATE aqinvoices SET ";
2681 $query .= join(",", @set_strs);
2682 $query .= " WHERE invoiceid = ?";
2684 my $sth = $dbh->prepare($query);
2685 $sth->execute(@set_args, $invoice{invoiceid
});
2690 CloseInvoice($invoiceid);
2694 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2699 my ($invoiceid) = @_;
2701 return unless $invoiceid;
2703 my $dbh = C4
::Context
->dbh;
2706 SET closedate
= CAST
(NOW
() AS DATE
)
2709 my $sth = $dbh->prepare($query);
2710 $sth->execute($invoiceid);
2713 =head3 ReopenInvoice
2715 ReopenInvoice($invoiceid);
2719 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => C4::Dates->new()->output('iso'))
2724 my ($invoiceid) = @_;
2726 return unless $invoiceid;
2728 my $dbh = C4
::Context
->dbh;
2731 SET closedate
= NULL
2734 my $sth = $dbh->prepare($query);
2735 $sth->execute($invoiceid);
2740 DelInvoice($invoiceid);
2742 Delete an invoice if there are no items attached to it.
2747 my ($invoiceid) = @_;
2749 return unless $invoiceid;
2751 my $dbh = C4
::Context
->dbh;
2757 my $sth = $dbh->prepare($query);
2758 $sth->execute($invoiceid);
2759 my $res = $sth->fetchrow_arrayref;
2760 if ( $res && $res->[0] == 0 ) {
2762 DELETE FROM aqinvoices
2765 my $sth = $dbh->prepare($query);
2766 return ( $sth->execute($invoiceid) > 0 );
2771 =head3 MergeInvoices
2773 MergeInvoices($invoiceid, \@sourceids);
2775 Merge the invoices identified by the IDs in \@sourceids into
2776 the invoice identified by $invoiceid.
2781 my ($invoiceid, $sourceids) = @_;
2783 return unless $invoiceid;
2784 foreach my $sourceid (@
$sourceids) {
2785 next if $sourceid == $invoiceid;
2786 my $source = GetInvoiceDetails
($sourceid);
2787 foreach my $order (@
{$source->{'orders'}}) {
2788 $order->{'invoiceid'} = $invoiceid;
2791 DelInvoice
($source->{'invoiceid'});
2796 =head3 GetBiblioCountByBasketno
2798 $biblio_count = &GetBiblioCountByBasketno($basketno);
2800 Looks up the biblio's count that has basketno value $basketno
2806 sub GetBiblioCountByBasketno
{
2807 my ($basketno) = @_;
2808 my $dbh = C4
::Context
->dbh;
2810 SELECT COUNT( DISTINCT( biblionumber ) )
2813 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
2816 my $sth = $dbh->prepare($query);
2817 $sth->execute($basketno);
2818 return $sth->fetchrow;
2821 # This is *not* the good way to calcul prices
2822 # But it's how it works at the moment into Koha
2823 # This will be fixed later.
2824 # Note this subroutine should be moved to Koha::Acquisition::Order
2825 # Will do when a DBIC decision will be taken.
2826 sub populate_order_with_prices
{
2829 my $order = $params->{order
};
2830 my $booksellerid = $params->{booksellerid
};
2831 return unless $booksellerid;
2833 my $bookseller = Koha
::Acquisition
::Bookseller
->fetch({ id
=> $booksellerid });
2835 my $receiving = $params->{receiving
};
2836 my $ordering = $params->{ordering
};
2837 my $discount = $order->{discount
};
2838 $discount /= 100 if $discount > 1;
2840 $order->{rrp
} = Koha
::Number
::Price
->new( $order->{rrp
} )->round;
2841 $order->{ecost
} = Koha
::Number
::Price
->new( $order->{ecost
} )->round;
2843 if ( $bookseller->{listincgst
} ) {
2844 $order->{rrpgsti
} = $order->{rrp
};
2845 $order->{rrpgste
} = Koha
::Number
::Price
->new(
2846 $order->{rrpgsti
} / ( 1 + $order->{gstrate
} ) )->round;
2847 $order->{ecostgsti
} = $order->{ecost
};
2848 $order->{ecostgste
} = Koha
::Number
::Price
->new(
2849 $order->{ecost
} / ( 1 + $order->{gstrate
} ) )->round;
2850 $order->{gstvalue
} = Koha
::Number
::Price
->new(
2851 ( $order->{ecostgsti
} - $order->{ecostgste
} ) *
2852 $order->{quantity
} )->round;
2853 $order->{totalgste
} = $order->{ecostgste
} * $order->{quantity
};
2854 $order->{totalgsti
} = $order->{ecostgsti
} * $order->{quantity
};
2857 $order->{rrpgste
} = $order->{rrp
};
2858 $order->{rrpgsti
} = Koha
::Number
::Price
->new(
2859 $order->{rrp
} * ( 1 + $order->{gstrate
} ) )->round;
2860 $order->{ecostgste
} = $order->{ecost
};
2861 $order->{ecostgsti
} = Koha
::Number
::Price
->new(
2862 $order->{ecost
} * ( 1 + $order->{gstrate
} ) )->round;
2863 $order->{gstvalue
} = Koha
::Number
::Price
->new(
2864 ( $order->{ecostgsti
} - $order->{ecostgste
} ) *
2865 $order->{quantity
} )->round;
2866 $order->{totalgste
} = $order->{ecostgste
} * $order->{quantity
};
2867 $order->{totalgsti
} = $order->{ecostgsti
} * $order->{quantity
};
2873 # if ( $bookseller->{invoiceincgst} ) {
2874 # $order->{unitpricegsti} = $order->{unitprice};
2875 # $order->{unitpricegste} =
2876 # $order->{unitpricegsti} / ( 1 + $order->{gstrate} );
2879 # $order->{unitpricegste} = $order->{unitprice};
2880 # $order->{unitpricegsti} =
2881 # $order->{unitpricegste} * ( 1 + $order->{gstrate} );
2883 # $order->{gstvalue} =
2884 # $order->{quantityreceived} *
2885 # $order->{unitpricegste} *
2886 # $order->{gstrate};
2897 Koha Development Team <http://koha-community.org/>