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
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
29 use C4::Templates qw(gettemplate);
30 use Koha::DateUtils qw( dt_from_string output_pref );
31 use Koha::Acquisition::Order;
32 use Koha::Acquisition::Bookseller;
33 use Koha::Number::Price;
35 use C4::Koha qw( subfield_is_koha_internal_p );
42 use vars qw($VERSION @ISA @EXPORT);
45 # set the version for version checking
46 $VERSION = 3.07.00.049;
50 &GetBasket &NewBasket &CloseBasket &ReopenBasket &DelBasket &ModBasket
51 &GetBasketAsCSV &GetBasketGroupAsCSV
52 &GetBasketsByBookseller &GetBasketsByBasketgroup
53 &GetBasketsInfosByBookseller
55 &GetBasketUsers &ModBasketUsers
60 &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup
61 &GetBasketgroups &ReOpenBasketgroup
63 &DelOrder &ModOrder &GetOrder &GetOrders &GetOrdersByBiblionumber
64 &GetLateOrders &GetOrderFromItemnumber
65 &SearchOrders &GetHistory &GetRecentAcqui
66 &ModReceiveOrder &CancelReceipt
68 &GetLastOrderNotReceivedFromSubscriptionid &GetLastOrderReceivedFromSubscriptionid
83 &GetItemnumbersFromOrder
86 &GetBiblioCountByBasketno
92 &FillWithDefaultValues
100 sub GetOrderFromItemnumber {
101 my ($itemnumber) = @_;
102 my $dbh = C4::Context->dbh;
105 SELECT * from aqorders LEFT JOIN aqorders_items
106 ON ( aqorders.ordernumber = aqorders_items.ordernumber )
107 WHERE itemnumber = ? |;
109 my $sth = $dbh->prepare($query);
113 $sth->execute($itemnumber);
115 my $order = $sth->fetchrow_hashref;
120 # Returns the itemnumber(s) associated with the ordernumber given in parameter
121 sub GetItemnumbersFromOrder {
122 my ($ordernumber) = @_;
123 my $dbh = C4::Context->dbh;
124 my $query = "SELECT itemnumber FROM aqorders_items WHERE ordernumber=?";
125 my $sth = $dbh->prepare($query);
126 $sth->execute($ordernumber);
129 while (my $order = $sth->fetchrow_hashref) {
130 push @tab, $order->{'itemnumber'};
144 C4::Acquisition - Koha functions for dealing with orders and acquisitions
152 The functions in this module deal with acquisitions, managing book
153 orders, basket and parcels.
157 =head2 FUNCTIONS ABOUT BASKETS
161 $aqbasket = &GetBasket($basketnumber);
163 get all basket informations in aqbasket for a given basket
165 B<returns:> informations for a given basket returned as a hashref.
171 my $dbh = C4::Context->dbh;
174 concat( b.firstname,' ',b.surname) AS authorisedbyname
176 LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
179 my $sth=$dbh->prepare($query);
180 $sth->execute($basketno);
181 my $basket = $sth->fetchrow_hashref;
185 #------------------------------------------------------------#
189 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
190 $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace );
192 Create a new basket in aqbasket table
196 =item C<$booksellerid> is a foreign key in the aqbasket table
198 =item C<$authorizedby> is the username of who created the basket
202 The other parameters are optional, see ModBasketHeader for more info on them.
207 my ( $booksellerid, $authorisedby, $basketname, $basketnote,
208 $basketbooksellernote, $basketcontractnumber, $deliveryplace,
209 $billingplace ) = @_;
210 my $dbh = C4::Context->dbh;
212 'INSERT INTO aqbasket (creationdate,booksellerid,authorisedby) '
213 . 'VALUES (now(),?,?)';
214 $dbh->do( $query, {}, $booksellerid, $authorisedby );
216 my $basket = $dbh->{mysql_insertid};
217 $basketname ||= q{}; # default to empty strings
219 $basketbooksellernote ||= q{};
220 ModBasketHeader( $basket, $basketname, $basketnote, $basketbooksellernote,
221 $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace );
225 #------------------------------------------------------------#
229 &CloseBasket($basketno);
231 close a basket (becomes unmodifiable, except for receives)
237 my $dbh = C4::Context->dbh;
238 $dbh->do('UPDATE aqbasket SET closedate=now() WHERE basketno=?', {}, $basketno );
240 $dbh->do( q{UPDATE aqorders SET orderstatus = 'ordered' WHERE basketno = ? AND orderstatus != 'complete'},
247 &ReopenBasket($basketno);
255 my $dbh = C4::Context->dbh;
256 $dbh->do( q{UPDATE aqbasket SET closedate=NULL WHERE basketno=?}, {}, $basketno );
260 SET orderstatus = 'new'
262 AND orderstatus != 'complete'
267 #------------------------------------------------------------#
269 =head3 GetBasketAsCSV
271 &GetBasketAsCSV($basketno);
273 Export a basket as CSV
275 $cgi parameter is needed for column name translation
280 my ($basketno, $cgi) = @_;
281 my $basket = GetBasket($basketno);
282 my @orders = GetOrders($basketno);
283 my $contract = GetContract({
284 contractnumber => $basket->{'contractnumber'}
287 my $template = C4::Templates::gettemplate("acqui/csv/basket.tt", "intranet", $cgi);
290 foreach my $order (@orders) {
291 my $bd = GetBiblioData( $order->{'biblionumber'} );
293 contractname => $contract->{'contractname'},
294 ordernumber => $order->{'ordernumber'},
295 entrydate => $order->{'entrydate'},
296 isbn => $order->{'isbn'},
297 author => $bd->{'author'},
298 title => $bd->{'title'},
299 publicationyear => $bd->{'publicationyear'},
300 publishercode => $bd->{'publishercode'},
301 collectiontitle => $bd->{'collectiontitle'},
302 notes => $order->{'order_vendornote'},
303 quantity => $order->{'quantity'},
304 rrp => $order->{'rrp'},
305 deliveryplace => C4::Branch::GetBranchName( $basket->{'deliveryplace'} ),
306 billingplace => C4::Branch::GetBranchName( $basket->{'billingplace'} ),
309 contractname author title publishercode collectiontitle notes
310 deliveryplace billingplace
312 # Double the quotes to not be interpreted as a field end
313 $row->{$_} =~ s/"/""/g if $row->{$_};
319 if(defined $a->{publishercode} and defined $b->{publishercode}) {
320 $a->{publishercode} cmp $b->{publishercode};
324 $template->param(rows => \@rows);
326 return $template->output;
330 =head3 GetBasketGroupAsCSV
332 &GetBasketGroupAsCSV($basketgroupid);
334 Export a basket group as CSV
336 $cgi parameter is needed for column name translation
340 sub GetBasketGroupAsCSV {
341 my ($basketgroupid, $cgi) = @_;
342 my $baskets = GetBasketsByBasketgroup($basketgroupid);
344 my $template = C4::Templates::gettemplate('acqui/csv/basketgroup.tt', 'intranet', $cgi);
347 for my $basket (@$baskets) {
348 my @orders = GetOrders( $basket->{basketno} );
349 my $contract = GetContract({
350 contractnumber => $basket->{contractnumber}
352 my $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $basket->{booksellerid} });
353 my $basketgroup = GetBasketgroup( $$basket{basketgroupid} );
355 foreach my $order (@orders) {
356 my $bd = GetBiblioData( $order->{'biblionumber'} );
358 clientnumber => $bookseller->{accountnumber},
359 basketname => $basket->{basketname},
360 ordernumber => $order->{ordernumber},
361 author => $bd->{author},
362 title => $bd->{title},
363 publishercode => $bd->{publishercode},
364 publicationyear => $bd->{publicationyear},
365 collectiontitle => $bd->{collectiontitle},
366 isbn => $order->{isbn},
367 quantity => $order->{quantity},
368 rrp => $order->{rrp},
369 discount => $bookseller->{discount},
370 ecost => $order->{ecost},
371 notes => $order->{order_vendornote},
372 entrydate => $order->{entrydate},
373 booksellername => $bookseller->{name},
374 bookselleraddress => $bookseller->{address1},
375 booksellerpostal => $bookseller->{postal},
376 contractnumber => $contract->{contractnumber},
377 contractname => $contract->{contractname},
378 basketgroupdeliveryplace => C4::Branch::GetBranchName( $basketgroup->{deliveryplace} ),
379 basketgroupbillingplace => C4::Branch::GetBranchName( $basketgroup->{billingplace} ),
380 basketdeliveryplace => C4::Branch::GetBranchName( $basket->{deliveryplace} ),
381 basketbillingplace => C4::Branch::GetBranchName( $basket->{billingplace} ),
384 basketname author title publishercode collectiontitle notes
385 booksellername bookselleraddress booksellerpostal contractname
386 basketgroupdeliveryplace basketgroupbillingplace
387 basketdeliveryplace basketbillingplace
389 # Double the quotes to not be interpreted as a field end
390 $row->{$_} =~ s/"/""/g if $row->{$_};
395 $template->param(rows => \@rows);
397 return $template->output;
401 =head3 CloseBasketgroup
403 &CloseBasketgroup($basketgroupno);
409 sub CloseBasketgroup {
410 my ($basketgroupno) = @_;
411 my $dbh = C4::Context->dbh;
412 my $sth = $dbh->prepare("
413 UPDATE aqbasketgroups
417 $sth->execute($basketgroupno);
420 #------------------------------------------------------------#
422 =head3 ReOpenBaskergroup($basketgroupno)
424 &ReOpenBaskergroup($basketgroupno);
430 sub ReOpenBasketgroup {
431 my ($basketgroupno) = @_;
432 my $dbh = C4::Context->dbh;
433 my $sth = $dbh->prepare("
434 UPDATE aqbasketgroups
438 $sth->execute($basketgroupno);
441 #------------------------------------------------------------#
446 &DelBasket($basketno);
448 Deletes the basket that has basketno field $basketno in the aqbasket table.
452 =item C<$basketno> is the primary key of the basket in the aqbasket table.
459 my ( $basketno ) = @_;
460 my $query = "DELETE FROM aqbasket WHERE basketno=?";
461 my $dbh = C4::Context->dbh;
462 my $sth = $dbh->prepare($query);
463 $sth->execute($basketno);
467 #------------------------------------------------------------#
471 &ModBasket($basketinfo);
473 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
477 =item C<$basketno> is the primary key of the basket in the aqbasket table.
484 my $basketinfo = shift;
485 my $query = "UPDATE aqbasket SET ";
487 foreach my $key (keys %$basketinfo){
488 if ($key ne 'basketno'){
489 $query .= "$key=?, ";
490 push(@params, $basketinfo->{$key} || undef );
493 # get rid of the "," at the end of $query
494 if (substr($query, length($query)-2) eq ', '){
499 $query .= "WHERE basketno=?";
500 push(@params, $basketinfo->{'basketno'});
501 my $dbh = C4::Context->dbh;
502 my $sth = $dbh->prepare($query);
503 $sth->execute(@params);
508 #------------------------------------------------------------#
510 =head3 ModBasketHeader
512 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
514 Modifies a basket's header.
518 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
520 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
522 =item C<$note> is the "note" field in the "aqbasket" table;
524 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
526 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
528 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
530 =item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
532 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
538 sub ModBasketHeader {
539 my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace) = @_;
542 SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=?
546 my $dbh = C4::Context->dbh;
547 my $sth = $dbh->prepare($query);
548 $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $basketno);
550 if ( $contractnumber ) {
551 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
552 my $sth2 = $dbh->prepare($query2);
553 $sth2->execute($contractnumber,$basketno);
558 #------------------------------------------------------------#
560 =head3 GetBasketsByBookseller
562 @results = &GetBasketsByBookseller($booksellerid, $extra);
564 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
568 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
570 =item C<$extra> is the extra sql parameters, can be
572 $extra->{groupby}: group baskets by column
573 ex. $extra->{groupby} = aqbasket.basketgroupid
574 $extra->{orderby}: order baskets by column
575 $extra->{limit}: limit number of results (can be helpful for pagination)
581 sub GetBasketsByBookseller {
582 my ($booksellerid, $extra) = @_;
583 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
585 if ($extra->{groupby}) {
586 $query .= " GROUP by $extra->{groupby}";
588 if ($extra->{orderby}){
589 $query .= " ORDER by $extra->{orderby}";
591 if ($extra->{limit}){
592 $query .= " LIMIT $extra->{limit}";
595 my $dbh = C4::Context->dbh;
596 my $sth = $dbh->prepare($query);
597 $sth->execute($booksellerid);
598 return $sth->fetchall_arrayref({});
601 =head3 GetBasketsInfosByBookseller
603 my $baskets = GetBasketsInfosByBookseller($supplierid, $allbaskets);
605 The optional second parameter allbaskets is a boolean allowing you to
606 select all baskets from the supplier; by default only active baskets (open or
607 closed but still something to receive) are returned.
609 Returns in a arrayref of hashref all about booksellers baskets, plus:
610 total_biblios: Number of distinct biblios in basket
611 total_items: Number of items in basket
612 expected_items: Number of non-received items in basket
616 sub GetBasketsInfosByBookseller {
617 my ($supplierid, $allbaskets) = @_;
619 return unless $supplierid;
621 my $dbh = C4::Context->dbh;
624 SUM(aqorders.quantity) AS total_items,
626 IF ( aqorders.orderstatus = 'cancelled', aqorders.quantity, 0 )
627 ) AS total_items_cancelled,
628 COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
630 IF(aqorders.datereceived IS NULL
631 AND aqorders.datecancellationprinted IS NULL
636 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
637 WHERE booksellerid = ?};
639 unless ( $allbaskets ) {
640 $query.=" AND (closedate IS NULL OR (aqorders.quantity > aqorders.quantityreceived AND datecancellationprinted IS NULL))";
642 $query.=" GROUP BY aqbasket.basketno";
644 my $sth = $dbh->prepare($query);
645 $sth->execute($supplierid);
646 my $baskets = $sth->fetchall_arrayref({});
648 # Retrieve the number of biblios cancelled
649 my $cancelled_biblios = $dbh->selectall_hashref( q|
650 SELECT COUNT(DISTINCT(biblionumber)) AS total_biblios_cancelled, aqbasket.basketno
652 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
653 WHERE booksellerid = ?
654 AND aqorders.orderstatus = 'cancelled'
655 GROUP BY aqbasket.basketno
656 |, 'basketno', {}, $supplierid );
658 $_->{total_biblios_cancelled} = $cancelled_biblios->{$_->{basketno}}{total_biblios_cancelled} || 0
664 =head3 GetBasketUsers
666 $basketusers_ids = &GetBasketUsers($basketno);
668 Returns a list of all borrowernumbers that are in basket users list
673 my $basketno = shift;
675 return unless $basketno;
678 SELECT borrowernumber
682 my $dbh = C4::Context->dbh;
683 my $sth = $dbh->prepare($query);
684 $sth->execute($basketno);
685 my $results = $sth->fetchall_arrayref( {} );
688 foreach (@$results) {
689 push @borrowernumbers, $_->{'borrowernumber'};
692 return @borrowernumbers;
695 =head3 ModBasketUsers
697 my @basketusers_ids = (1, 2, 3);
698 &ModBasketUsers($basketno, @basketusers_ids);
700 Delete all users from basket users list, and add users in C<@basketusers_ids>
706 my ($basketno, @basketusers_ids) = @_;
708 return unless $basketno;
710 my $dbh = C4::Context->dbh;
712 DELETE FROM aqbasketusers
715 my $sth = $dbh->prepare($query);
716 $sth->execute($basketno);
719 INSERT INTO aqbasketusers (basketno, borrowernumber)
722 $sth = $dbh->prepare($query);
723 foreach my $basketuser_id (@basketusers_ids) {
724 $sth->execute($basketno, $basketuser_id);
729 =head3 CanUserManageBasket
731 my $bool = CanUserManageBasket($borrower, $basket[, $userflags]);
732 my $bool = CanUserManageBasket($borrowernumber, $basketno[, $userflags]);
734 Check if a borrower can manage a basket, according to system preference
735 AcqViewBaskets, user permissions and basket properties (creator, users list,
738 First parameter can be either a borrowernumber or a hashref as returned by
739 C4::Members::GetMember.
741 Second parameter can be either a basketno or a hashref as returned by
742 C4::Acquisition::GetBasket.
744 The third parameter is optional. If given, it should be a hashref as returned
745 by C4::Auth::getuserflags. If not, getuserflags is called.
747 If user is authorised to manage basket, returns 1.
752 sub CanUserManageBasket {
753 my ($borrower, $basket, $userflags) = @_;
755 if (!ref $borrower) {
756 $borrower = C4::Members::GetMember(borrowernumber => $borrower);
759 $basket = GetBasket($basket);
762 return 0 unless ($basket and $borrower);
764 my $borrowernumber = $borrower->{borrowernumber};
765 my $basketno = $basket->{basketno};
767 my $AcqViewBaskets = C4::Context->preference('AcqViewBaskets');
769 if (!defined $userflags) {
770 my $dbh = C4::Context->dbh;
771 my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE borrowernumber = ?");
772 $sth->execute($borrowernumber);
773 my ($flags) = $sth->fetchrow_array;
776 $userflags = C4::Auth::getuserflags($flags, $borrower->{userid}, $dbh);
779 unless ($userflags->{superlibrarian}
780 || (ref $userflags->{acquisition} && $userflags->{acquisition}->{order_manage_all})
781 || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
783 if (not exists $userflags->{acquisition}) {
787 if ( (ref $userflags->{acquisition} && !$userflags->{acquisition}->{order_manage})
788 || (!ref $userflags->{acquisition} && !$userflags->{acquisition}) ) {
792 if ($AcqViewBaskets eq 'user'
793 && $basket->{authorisedby} != $borrowernumber
794 && grep($borrowernumber, GetBasketUsers($basketno)) == 0) {
798 if ($AcqViewBaskets eq 'branch' && defined $basket->{branch}
799 && $basket->{branch} ne $borrower->{branchcode}) {
807 #------------------------------------------------------------#
809 =head3 GetBasketsByBasketgroup
811 $baskets = &GetBasketsByBasketgroup($basketgroupid);
813 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
817 sub GetBasketsByBasketgroup {
818 my $basketgroupid = shift;
820 SELECT *, aqbasket.booksellerid as booksellerid
822 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?
824 my $dbh = C4::Context->dbh;
825 my $sth = $dbh->prepare($query);
826 $sth->execute($basketgroupid);
827 return $sth->fetchall_arrayref({});
830 #------------------------------------------------------------#
832 =head3 NewBasketgroup
834 $basketgroupid = NewBasketgroup(\%hashref);
836 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
838 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
840 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
842 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
844 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
846 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
848 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
850 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
852 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
857 my $basketgroupinfo = shift;
858 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
859 my $query = "INSERT INTO aqbasketgroups (";
861 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
862 if ( defined $basketgroupinfo->{$field} ) {
863 $query .= "$field, ";
864 push(@params, $basketgroupinfo->{$field});
867 $query .= "booksellerid) VALUES (";
872 push(@params, $basketgroupinfo->{'booksellerid'});
873 my $dbh = C4::Context->dbh;
874 my $sth = $dbh->prepare($query);
875 $sth->execute(@params);
876 my $basketgroupid = $dbh->{'mysql_insertid'};
877 if( $basketgroupinfo->{'basketlist'} ) {
878 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
879 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
880 my $sth2 = $dbh->prepare($query2);
881 $sth2->execute($basketgroupid, $basketno);
884 return $basketgroupid;
887 #------------------------------------------------------------#
889 =head3 ModBasketgroup
891 ModBasketgroup(\%hashref);
893 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
895 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
897 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
899 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
901 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
903 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
905 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
907 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
909 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
914 my $basketgroupinfo = shift;
915 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
916 my $dbh = C4::Context->dbh;
917 my $query = "UPDATE aqbasketgroups SET ";
919 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
920 if ( defined $basketgroupinfo->{$field} ) {
921 $query .= "$field=?, ";
922 push(@params, $basketgroupinfo->{$field});
927 $query .= " WHERE id=?";
928 push(@params, $basketgroupinfo->{'id'});
929 my $sth = $dbh->prepare($query);
930 $sth->execute(@params);
932 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
933 $sth->execute($basketgroupinfo->{'id'});
935 if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
936 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
937 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
938 $sth->execute($basketgroupinfo->{'id'}, $basketno);
944 #------------------------------------------------------------#
946 =head3 DelBasketgroup
948 DelBasketgroup($basketgroupid);
950 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
954 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
961 my $basketgroupid = shift;
962 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
963 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
964 my $dbh = C4::Context->dbh;
965 my $sth = $dbh->prepare($query);
966 $sth->execute($basketgroupid);
970 #------------------------------------------------------------#
973 =head2 FUNCTIONS ABOUT ORDERS
975 =head3 GetBasketgroup
977 $basketgroup = &GetBasketgroup($basketgroupid);
979 Returns a reference to the hash containing all information about the basketgroup.
984 my $basketgroupid = shift;
985 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
986 my $dbh = C4::Context->dbh;
987 my $result_set = $dbh->selectall_arrayref(
988 'SELECT * FROM aqbasketgroups WHERE id=?',
992 return $result_set->[0]; # id is unique
995 #------------------------------------------------------------#
997 =head3 GetBasketgroups
999 $basketgroups = &GetBasketgroups($booksellerid);
1001 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
1005 sub GetBasketgroups {
1006 my $booksellerid = shift;
1007 die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
1008 my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
1009 my $dbh = C4::Context->dbh;
1010 my $sth = $dbh->prepare($query);
1011 $sth->execute($booksellerid);
1012 return $sth->fetchall_arrayref({});
1015 #------------------------------------------------------------#
1017 =head2 FUNCTIONS ABOUT ORDERS
1021 @orders = &GetOrders( $basketno, { orderby => 'biblio.title', cancelled => 0|1 } );
1023 Looks up the pending (non-cancelled) orders with the given basket
1026 If cancelled is set, only cancelled orders will be returned.
1031 my ( $basketno, $params ) = @_;
1033 return () unless $basketno;
1035 my $orderby = $params->{orderby};
1036 my $cancelled = $params->{cancelled} || 0;
1038 my $dbh = C4::Context->dbh;
1040 SELECT biblio.*,biblioitems.*,
1044 $query .= $cancelled
1046 aqorders_transfers.ordernumber_to AS transferred_to,
1047 aqorders_transfers.timestamp AS transferred_to_timestamp
1050 aqorders_transfers.ordernumber_from AS transferred_from,
1051 aqorders_transfers.timestamp AS transferred_from_timestamp
1055 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1056 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1057 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1059 $query .= $cancelled
1061 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
1064 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1072 $orderby ||= q|biblioitems.publishercode, biblio.title|;
1074 AND (datecancellationprinted IS NOT NULL
1075 AND datecancellationprinted <> '0000-00-00')
1080 q|aqorders.datecancellationprinted desc, aqorders.timestamp desc|;
1082 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
1086 $query .= " ORDER BY $orderby";
1088 $dbh->selectall_arrayref( $query, { Slice => {} }, $basketno );
1093 #------------------------------------------------------------#
1095 =head3 GetOrdersByBiblionumber
1097 @orders = &GetOrdersByBiblionumber($biblionumber);
1099 Looks up the orders with linked to a specific $biblionumber, including
1100 cancelled orders and received orders.
1103 C<@orders> is an array of references-to-hash, whose keys are the
1104 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
1108 sub GetOrdersByBiblionumber {
1109 my $biblionumber = shift;
1110 return unless $biblionumber;
1111 my $dbh = C4::Context->dbh;
1113 SELECT biblio.*,biblioitems.*,
1117 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1118 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1119 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1120 WHERE aqorders.biblionumber=?
1123 $dbh->selectall_arrayref( $query, { Slice => {} }, $biblionumber );
1124 return @{$result_set};
1128 #------------------------------------------------------------#
1132 $order = &GetOrder($ordernumber);
1134 Looks up an order by order number.
1136 Returns a reference-to-hash describing the order. The keys of
1137 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1142 my ($ordernumber) = @_;
1143 return unless $ordernumber;
1145 my $dbh = C4::Context->dbh;
1146 my $query = qq{SELECT
1150 aqbasket.basketname,
1151 borrowers.branchcode,
1152 biblioitems.publicationyear,
1153 biblio.copyrightdate,
1154 biblioitems.editionstatement,
1158 biblioitems.publishercode,
1159 aqorders.rrp AS unitpricesupplier,
1160 aqorders.ecost AS unitpricelib,
1161 aqorders.claims_count AS claims_count,
1162 aqorders.claimed_date AS claimed_date,
1163 aqbudgets.budget_name AS budget,
1164 aqbooksellers.name AS supplier,
1165 aqbooksellers.id AS supplierid,
1166 biblioitems.publishercode AS publisher,
1167 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1168 DATE(aqbasket.closedate) AS orderdate,
1169 aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity_to_receive,
1170 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1171 DATEDIFF(CURDATE( ),closedate) AS latesince
1172 FROM aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1173 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1174 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1175 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
1176 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1177 WHERE aqorders.basketno = aqbasket.basketno
1180 $dbh->selectall_arrayref( $query, { Slice => {} }, $ordernumber );
1182 # result_set assumed to contain 1 match
1183 return $result_set->[0];
1186 =head3 GetLastOrderNotReceivedFromSubscriptionid
1188 $order = &GetLastOrderNotReceivedFromSubscriptionid($subscriptionid);
1190 Returns a reference-to-hash describing the last order not received for a subscription.
1194 sub GetLastOrderNotReceivedFromSubscriptionid {
1195 my ( $subscriptionid ) = @_;
1196 my $dbh = C4::Context->dbh;
1198 SELECT * FROM aqorders
1199 LEFT JOIN subscription
1200 ON ( aqorders.subscriptionid = subscription.subscriptionid )
1201 WHERE aqorders.subscriptionid = ?
1202 AND aqorders.datereceived IS NULL
1206 $dbh->selectall_arrayref( $query, { Slice => {} }, $subscriptionid );
1208 # result_set assumed to contain 1 match
1209 return $result_set->[0];
1212 =head3 GetLastOrderReceivedFromSubscriptionid
1214 $order = &GetLastOrderReceivedFromSubscriptionid($subscriptionid);
1216 Returns a reference-to-hash describing the last order received for a subscription.
1220 sub GetLastOrderReceivedFromSubscriptionid {
1221 my ( $subscriptionid ) = @_;
1222 my $dbh = C4::Context->dbh;
1224 SELECT * FROM aqorders
1225 LEFT JOIN subscription
1226 ON ( aqorders.subscriptionid = subscription.subscriptionid )
1227 WHERE aqorders.subscriptionid = ?
1228 AND aqorders.datereceived =
1230 SELECT MAX( aqorders.datereceived )
1232 LEFT JOIN subscription
1233 ON ( aqorders.subscriptionid = subscription.subscriptionid )
1234 WHERE aqorders.subscriptionid = ?
1235 AND aqorders.datereceived IS NOT NULL
1237 ORDER BY ordernumber DESC
1241 $dbh->selectall_arrayref( $query, { Slice => {} }, $subscriptionid, $subscriptionid );
1243 # result_set assumed to contain 1 match
1244 return $result_set->[0];
1248 #------------------------------------------------------------#
1252 &ModOrder(\%hashref);
1254 Modifies an existing order. Updates the order with order number
1255 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1256 other keys of the hash update the fields with the same name in the aqorders
1257 table of the Koha database.
1262 my $orderinfo = shift;
1264 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '';
1266 my $dbh = C4::Context->dbh;
1269 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1270 $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1272 # delete($orderinfo->{'branchcode'});
1273 # the hash contains a lot of entries not in aqorders, so get the columns ...
1274 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1276 my $colnames = $sth->{NAME};
1277 #FIXME Be careful. If aqorders would have columns with diacritics,
1278 #you should need to decode what you get back from NAME.
1279 #See report 10110 and guided_reports.pl
1280 my $query = "UPDATE aqorders SET ";
1282 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1283 # ... and skip hash entries that are not in the aqorders table
1284 # FIXME : probably not the best way to do it (would be better to have a correct hash)
1285 next unless grep(/^$orderinfokey$/, @$colnames);
1286 $query .= "$orderinfokey=?, ";
1287 push(@params, $orderinfo->{$orderinfokey});
1290 $query .= "timestamp=NOW() WHERE ordernumber=?";
1291 push(@params, $orderinfo->{'ordernumber'} );
1292 $sth = $dbh->prepare($query);
1293 $sth->execute(@params);
1297 #------------------------------------------------------------#
1301 ModItemOrder($itemnumber, $ordernumber);
1303 Modifies the ordernumber of an item in aqorders_items.
1308 my ($itemnumber, $ordernumber) = @_;
1310 return unless ($itemnumber and $ordernumber);
1312 my $dbh = C4::Context->dbh;
1314 UPDATE aqorders_items
1316 WHERE itemnumber = ?
1318 my $sth = $dbh->prepare($query);
1319 return $sth->execute($ordernumber, $itemnumber);
1322 #------------------------------------------------------------#
1324 =head3 ModReceiveOrder
1327 biblionumber => $biblionumber,
1328 ordernumber => $ordernumber,
1329 quantityreceived => $quantityreceived,
1333 invoiceid => $invoiceid,
1335 budget_id => $budget_id,
1336 datereceived => $datereceived,
1337 received_itemnumbers => \@received_itemnumbers,
1338 order_internalnote => $order_internalnote,
1339 order_vendornote => $order_vendornote,
1342 Updates an order, to reflect the fact that it was received, at least
1343 in part. All arguments not mentioned below update the fields with the
1344 same name in the aqorders table of the Koha database.
1346 If a partial order is received, splits the order into two.
1348 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1354 sub ModReceiveOrder {
1355 my ( $params ) = @_;
1356 my $biblionumber = $params->{biblionumber};
1357 my $ordernumber = $params->{ordernumber};
1358 my $quantrec = $params->{quantityreceived};
1359 my $user = $params->{user};
1360 my $cost = $params->{cost};
1361 my $ecost = $params->{ecost};
1362 my $invoiceid = $params->{invoiceid};
1363 my $rrp = $params->{rrp};
1364 my $budget_id = $params->{budget_id};
1365 my $datereceived = $params->{datereceived};
1366 my $received_items = $params->{received_items};
1367 my $order_internalnote = $params->{order_internalnote};
1368 my $order_vendornote = $params->{order_vendornote};
1370 my $dbh = C4::Context->dbh;
1371 $datereceived = output_pref(
1373 dt => ( $datereceived ? dt_from_string( $datereceived ) : dt_from_string ),
1374 dateformat => 'iso',
1378 my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1379 if ($suggestionid) {
1380 ModSuggestion( {suggestionid=>$suggestionid,
1381 STATUS=>'AVAILABLE',
1382 biblionumber=> $biblionumber}
1386 my $result_set = $dbh->selectall_arrayref(
1387 q{SELECT * FROM aqorders WHERE biblionumber=? AND aqorders.ordernumber=?},
1388 { Slice => {} }, $biblionumber, $ordernumber
1391 # we assume we have a unique order
1392 my $order = $result_set->[0];
1394 my $new_ordernumber = $ordernumber;
1395 if ( $order->{quantity} > $quantrec ) {
1396 # Split order line in two parts: the first is the original order line
1397 # without received items (the quantity is decreased),
1398 # the second part is a new order line with quantity=quantityrec
1399 # (entirely received)
1403 orderstatus = 'partial'|;
1404 $query .= q|, order_internalnote = ?| if defined $order_internalnote;
1405 $query .= q|, order_vendornote = ?| if defined $order_vendornote;
1406 $query .= q| WHERE ordernumber = ?|;
1407 my $sth = $dbh->prepare($query);
1410 $order->{quantity} - $quantrec,
1411 ( defined $order_internalnote ? $order_internalnote : () ),
1412 ( defined $order_vendornote ? $order_vendornote : () ),
1416 delete $order->{'ordernumber'};
1417 $order->{'budget_id'} = ( $budget_id || $order->{'budget_id'} );
1418 $order->{'quantity'} = $quantrec;
1419 $order->{'quantityreceived'} = $quantrec;
1420 $order->{'datereceived'} = $datereceived;
1421 $order->{'invoiceid'} = $invoiceid;
1422 $order->{'unitprice'} = $cost;
1423 $order->{'rrp'} = $rrp;
1424 $order->{ecost} = $ecost;
1425 $order->{'orderstatus'} = 'complete';
1426 $new_ordernumber = Koha::Acquisition::Order->new($order)->insert->{ordernumber};
1428 if ($received_items) {
1429 foreach my $itemnumber (@$received_items) {
1430 ModItemOrder($itemnumber, $new_ordernumber);
1436 set quantityreceived=?,datereceived=?,invoiceid=?,
1437 unitprice=?,rrp=?,ecost=?,budget_id=?,orderstatus='complete'|;
1438 $query .= q|, order_internalnote = ?| if defined $order_internalnote;
1439 $query .= q|, order_vendornote = ?| if defined $order_vendornote;
1440 $query .= q| where biblionumber=? and ordernumber=?|;
1441 my $sth = $dbh->prepare( $query );
1449 ( $budget_id ? $budget_id : $order->{budget_id} ),
1450 ( defined $order_internalnote ? $order_internalnote : () ),
1451 ( defined $order_vendornote ? $order_vendornote : () ),
1456 # All items have been received, sent a notification to users
1457 NotifyOrderUsers( $ordernumber );
1460 return ($datereceived, $new_ordernumber);
1463 =head3 CancelReceipt
1465 my $parent_ordernumber = CancelReceipt($ordernumber);
1467 Cancel an order line receipt and update the parent order line, as if no
1469 If items are created at receipt (AcqCreateItem = receiving) then delete
1475 my $ordernumber = shift;
1477 return unless $ordernumber;
1479 my $dbh = C4::Context->dbh;
1481 SELECT datereceived, parent_ordernumber, quantity
1483 WHERE ordernumber = ?
1485 my $sth = $dbh->prepare($query);
1486 $sth->execute($ordernumber);
1487 my $order = $sth->fetchrow_hashref;
1489 warn "CancelReceipt: order $ordernumber does not exist";
1492 unless($order->{'datereceived'}) {
1493 warn "CancelReceipt: order $ordernumber is not received";
1497 my $parent_ordernumber = $order->{'parent_ordernumber'};
1499 my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1501 if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1502 # The order line has no parent, just mark it as not received
1505 SET quantityreceived = ?,
1508 orderstatus = 'ordered'
1509 WHERE ordernumber = ?
1511 $sth = $dbh->prepare($query);
1512 $sth->execute(0, undef, undef, $ordernumber);
1513 _cancel_items_receipt( $ordernumber );
1515 # The order line has a parent, increase parent quantity and delete
1518 SELECT quantity, datereceived
1520 WHERE ordernumber = ?
1522 $sth = $dbh->prepare($query);
1523 $sth->execute($parent_ordernumber);
1524 my $parent_order = $sth->fetchrow_hashref;
1525 unless($parent_order) {
1526 warn "Parent order $parent_ordernumber does not exist.";
1529 if($parent_order->{'datereceived'}) {
1530 warn "CancelReceipt: parent order is received.".
1531 " Can't cancel receipt.";
1537 orderstatus = 'ordered'
1538 WHERE ordernumber = ?
1540 $sth = $dbh->prepare($query);
1541 my $rv = $sth->execute(
1542 $order->{'quantity'} + $parent_order->{'quantity'},
1546 warn "Cannot update parent order line, so do not cancel".
1550 _cancel_items_receipt( $ordernumber, $parent_ordernumber );
1553 DELETE FROM aqorders
1554 WHERE ordernumber = ?
1556 $sth = $dbh->prepare($query);
1557 $sth->execute($ordernumber);
1561 if(C4::Context->preference('AcqCreateItem') eq 'ordering') {
1562 my @affects = split q{\|}, C4::Context->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1564 for my $in ( @itemnumbers ) {
1565 my $biblionumber = C4::Biblio::GetBiblionumberFromItemnumber( $in );
1566 my $frameworkcode = GetFrameworkCode($biblionumber);
1567 my ( $itemfield ) = GetMarcFromKohaField( 'items.itemnumber', $frameworkcode );
1568 my $item = C4::Items::GetMarcItem( $biblionumber, $in );
1569 for my $affect ( @affects ) {
1570 my ( $sf, $v ) = split q{=}, $affect, 2;
1571 foreach ( $item->field($itemfield) ) {
1572 $_->update( $sf => $v );
1575 C4::Items::ModItemFromMarc( $item, $biblionumber, $in );
1580 return $parent_ordernumber;
1583 sub _cancel_items_receipt {
1584 my ( $ordernumber, $parent_ordernumber ) = @_;
1585 $parent_ordernumber ||= $ordernumber;
1587 my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1588 if(C4::Context->preference('AcqCreateItem') eq 'receiving') {
1589 # Remove items that were created at receipt
1591 DELETE FROM items, aqorders_items
1592 USING items, aqorders_items
1593 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1595 my $dbh = C4::Context->dbh;
1596 my $sth = $dbh->prepare($query);
1597 foreach my $itemnumber (@itemnumbers) {
1598 $sth->execute($itemnumber, $itemnumber);
1602 foreach my $itemnumber (@itemnumbers) {
1603 ModItemOrder($itemnumber, $parent_ordernumber);
1608 #------------------------------------------------------------#
1612 @results = &SearchOrders({
1613 ordernumber => $ordernumber,
1615 biblionumber => $biblionumber,
1617 booksellerid => $booksellerid,
1618 basketno => $basketno,
1624 Searches for orders.
1626 C<$owner> Finds order for the logged in user.
1627 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1628 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1631 C<@results> is an array of references-to-hash with the keys are fields
1632 from aqorders, biblio, biblioitems and aqbasket tables.
1637 my ( $params ) = @_;
1638 my $ordernumber = $params->{ordernumber};
1639 my $search = $params->{search};
1640 my $ean = $params->{ean};
1641 my $booksellerid = $params->{booksellerid};
1642 my $basketno = $params->{basketno};
1643 my $basketname = $params->{basketname};
1644 my $basketgroupname = $params->{basketgroupname};
1645 my $owner = $params->{owner};
1646 my $pending = $params->{pending};
1647 my $ordered = $params->{ordered};
1648 my $biblionumber = $params->{biblionumber};
1649 my $budget_id = $params->{budget_id};
1651 my $dbh = C4::Context->dbh;
1654 SELECT aqbasket.basketno,
1656 borrowers.firstname,
1659 biblioitems.biblioitemnumber,
1660 aqbasket.authorisedby,
1661 aqbasket.booksellerid,
1663 aqbasket.creationdate,
1664 aqbasket.basketname,
1665 aqbasketgroups.id as basketgroupid,
1666 aqbasketgroups.name as basketgroupname,
1669 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1670 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1671 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1672 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1673 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1676 # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
1678 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1682 WHERE (datecancellationprinted is NULL)
1685 if ( $pending or $ordered ) {
1686 $query .= q{ AND (quantity > quantityreceived OR quantityreceived is NULL)};
1689 $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1692 my $userenv = C4::Context->userenv;
1693 if ( C4::Context->preference("IndependentBranches") ) {
1694 unless ( C4::Context->IsSuperLibrarian() ) {
1697 borrowers.branchcode = ?
1698 OR borrowers.branchcode = ''
1701 push @args, $userenv->{branch};
1705 if ( $ordernumber ) {
1706 $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1707 push @args, ( $ordernumber, $ordernumber );
1709 if ( $biblionumber ) {
1710 $query .= 'AND aqorders.biblionumber = ?';
1711 push @args, $biblionumber;
1714 $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1715 push @args, ("%$search%","%$search%","%$search%");
1718 $query .= ' AND biblioitems.ean = ?';
1721 if ( $booksellerid ) {
1722 $query .= 'AND aqbasket.booksellerid = ?';
1723 push @args, $booksellerid;
1726 $query .= 'AND aqbasket.basketno = ?';
1727 push @args, $basketno;
1730 $query .= 'AND aqbasket.basketname LIKE ?';
1731 push @args, "%$basketname%";
1733 if( $basketgroupname ) {
1734 $query .= ' AND aqbasketgroups.name LIKE ?';
1735 push @args, "%$basketgroupname%";
1739 $query .= ' AND aqbasket.authorisedby=? ';
1740 push @args, $userenv->{'number'};
1744 $query .= ' AND aqorders.budget_id = ?';
1745 push @args, $budget_id;
1748 $query .= ' ORDER BY aqbasket.basketno';
1750 my $sth = $dbh->prepare($query);
1751 $sth->execute(@args);
1752 return $sth->fetchall_arrayref({});
1755 #------------------------------------------------------------#
1759 &DelOrder($biblionumber, $ordernumber);
1761 Cancel the order with the given order and biblio numbers. It does not
1762 delete any entries in the aqorders table, it merely marks them as
1768 my ( $bibnum, $ordernumber, $delete_biblio, $reason ) = @_;
1771 my $dbh = C4::Context->dbh;
1774 SET datecancellationprinted=now(), orderstatus='cancelled'
1777 $query .= ", cancellationreason = ? ";
1780 WHERE biblionumber=? AND ordernumber=?
1782 my $sth = $dbh->prepare($query);
1784 $sth->execute($reason, $bibnum, $ordernumber);
1786 $sth->execute( $bibnum, $ordernumber );
1790 my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1791 foreach my $itemnumber (@itemnumbers){
1792 my $delcheck = C4::Items::DelItemCheck( $dbh, $bibnum, $itemnumber );
1794 if($delcheck != 1) {
1795 $error->{'delitem'} = 1;
1799 if($delete_biblio) {
1800 # We get the number of remaining items
1801 my $itemcount = C4::Items::GetItemsCount($bibnum);
1803 # If there are no items left,
1804 if ( $itemcount == 0 ) {
1805 # We delete the record
1806 my $delcheck = DelBiblio($bibnum);
1809 $error->{'delbiblio'} = 1;
1817 =head3 TransferOrder
1819 my $newordernumber = TransferOrder($ordernumber, $basketno);
1821 Transfer an order line to a basket.
1822 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1823 to BOOKSELLER on DATE' and create new order with internal note
1824 'Transferred from BOOKSELLER on DATE'.
1825 Move all attached items to the new order.
1826 Received orders cannot be transferred.
1827 Return the ordernumber of created order.
1832 my ($ordernumber, $basketno) = @_;
1834 return unless ($ordernumber and $basketno);
1836 my $order = GetOrder( $ordernumber );
1837 return if $order->{datereceived};
1838 my $basket = GetBasket($basketno);
1839 return unless $basket;
1841 my $dbh = C4::Context->dbh;
1842 my ($query, $sth, $rv);
1846 SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1847 WHERE ordernumber = ?
1849 $sth = $dbh->prepare($query);
1850 $rv = $sth->execute('cancelled', $ordernumber);
1852 delete $order->{'ordernumber'};
1853 delete $order->{parent_ordernumber};
1854 $order->{'basketno'} = $basketno;
1856 my $newordernumber = Koha::Acquisition::Order->new($order)->insert->{ordernumber};
1859 UPDATE aqorders_items
1861 WHERE ordernumber = ?
1863 $sth = $dbh->prepare($query);
1864 $sth->execute($newordernumber, $ordernumber);
1867 INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1870 $sth = $dbh->prepare($query);
1871 $sth->execute($ordernumber, $newordernumber);
1873 return $newordernumber;
1876 =head2 FUNCTIONS ABOUT PARCELS
1880 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1882 get a lists of parcels.
1889 is the bookseller this function has to get parcels.
1892 To know on what criteria the results list has to be ordered.
1895 is the booksellerinvoicenumber.
1897 =item $datefrom & $dateto
1898 to know on what date this function has to filter its search.
1903 a pointer on a hash list containing parcel informations as such :
1909 =item Last operation
1911 =item Number of biblio
1913 =item Number of items
1920 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1921 my $dbh = C4::Context->dbh;
1922 my @query_params = ();
1924 SELECT aqinvoices.invoicenumber,
1925 datereceived,purchaseordernumber,
1926 count(DISTINCT biblionumber) AS biblio,
1927 sum(quantity) AS itemsexpected,
1928 sum(quantityreceived) AS itemsreceived
1929 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1930 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1931 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1933 push @query_params, $bookseller;
1935 if ( defined $code ) {
1936 $strsth .= ' and aqinvoices.invoicenumber like ? ';
1937 # add a % to the end of the code to allow stemming.
1938 push @query_params, "$code%";
1941 if ( defined $datefrom ) {
1942 $strsth .= ' and datereceived >= ? ';
1943 push @query_params, $datefrom;
1946 if ( defined $dateto ) {
1947 $strsth .= 'and datereceived <= ? ';
1948 push @query_params, $dateto;
1951 $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
1953 # can't use a placeholder to place this column name.
1954 # but, we could probably be checking to make sure it is a column that will be fetched.
1955 $strsth .= "order by $order " if ($order);
1957 my $sth = $dbh->prepare($strsth);
1959 $sth->execute( @query_params );
1960 my $results = $sth->fetchall_arrayref({});
1964 #------------------------------------------------------------#
1966 =head3 GetLateOrders
1968 @results = &GetLateOrders;
1970 Searches for bookseller with late orders.
1973 the table of supplier with late issues. This table is full of hashref.
1979 my $supplierid = shift;
1981 my $estimateddeliverydatefrom = shift;
1982 my $estimateddeliverydateto = shift;
1984 my $dbh = C4::Context->dbh;
1986 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1987 my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1989 my @query_params = ();
1991 SELECT aqbasket.basketno,
1992 aqorders.ordernumber,
1993 DATE(aqbasket.closedate) AS orderdate,
1994 aqbasket.basketname AS basketname,
1995 aqbasket.basketgroupid AS basketgroupid,
1996 aqbasketgroups.name AS basketgroupname,
1997 aqorders.rrp AS unitpricesupplier,
1998 aqorders.ecost AS unitpricelib,
1999 aqorders.claims_count AS claims_count,
2000 aqorders.claimed_date AS claimed_date,
2001 aqbudgets.budget_name AS budget,
2002 borrowers.branchcode AS branch,
2003 aqbooksellers.name AS supplier,
2004 aqbooksellers.id AS supplierid,
2005 biblio.author, biblio.title,
2006 biblioitems.publishercode AS publisher,
2007 biblioitems.publicationyear,
2008 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
2012 aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
2013 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
2014 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
2015 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
2016 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
2017 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2018 WHERE aqorders.basketno = aqbasket.basketno
2019 AND ( datereceived = ''
2020 OR datereceived IS NULL
2021 OR aqorders.quantityreceived < aqorders.quantity
2023 AND aqbasket.closedate IS NOT NULL
2024 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
2027 if ($dbdriver eq "mysql") {
2029 aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity,
2030 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
2031 DATEDIFF(CAST(now() AS date),closedate) AS latesince
2033 if ( defined $delay ) {
2034 $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
2035 push @query_params, $delay;
2037 $having = "HAVING quantity <> 0";
2039 # FIXME: account for IFNULL as above
2041 aqorders.quantity AS quantity,
2042 aqorders.quantity * aqorders.rrp AS subtotal,
2043 (CAST(now() AS date) - closedate) AS latesince
2045 if ( defined $delay ) {
2046 $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
2047 push @query_params, $delay;
2050 if (defined $supplierid) {
2051 $from .= ' AND aqbasket.booksellerid = ? ';
2052 push @query_params, $supplierid;
2054 if (defined $branch) {
2055 $from .= ' AND borrowers.branchcode LIKE ? ';
2056 push @query_params, $branch;
2059 if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
2060 $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
2062 if ( defined $estimateddeliverydatefrom ) {
2063 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
2064 push @query_params, $estimateddeliverydatefrom;
2066 if ( defined $estimateddeliverydateto ) {
2067 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
2068 push @query_params, $estimateddeliverydateto;
2070 if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
2071 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
2073 if (C4::Context->preference("IndependentBranches")
2074 && !C4::Context->IsSuperLibrarian() ) {
2075 $from .= ' AND borrowers.branchcode LIKE ? ';
2076 push @query_params, C4::Context->userenv->{branch};
2078 $from .= " AND orderstatus <> 'cancelled' ";
2079 my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
2080 $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
2081 my $sth = $dbh->prepare($query);
2082 $sth->execute(@query_params);
2084 while (my $data = $sth->fetchrow_hashref) {
2085 push @results, $data;
2090 #------------------------------------------------------------#
2094 \@order_loop = GetHistory( %params );
2096 Retreives some acquisition history information
2106 basket - search both basket name and number
2107 booksellerinvoicenumber
2110 orderstatus (note that orderstatus '' will retrieve orders
2111 of any status except cancelled)
2113 get_canceled_order (if set to a true value, cancelled orders will
2117 $order_loop is a list of hashrefs that each look like this:
2119 'author' => 'Twain, Mark',
2121 'biblionumber' => '215',
2123 'creationdate' => 'MM/DD/YYYY',
2124 'datereceived' => undef,
2127 'invoicenumber' => undef,
2129 'ordernumber' => '1',
2131 'quantityreceived' => undef,
2132 'title' => 'The Adventures of Huckleberry Finn'
2138 # don't run the query if there are no parameters (list would be too long for sure !)
2139 croak "No search params" unless @_;
2141 my $title = $params{title};
2142 my $author = $params{author};
2143 my $isbn = $params{isbn};
2144 my $ean = $params{ean};
2145 my $name = $params{name};
2146 my $from_placed_on = $params{from_placed_on};
2147 my $to_placed_on = $params{to_placed_on};
2148 my $basket = $params{basket};
2149 my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2150 my $basketgroupname = $params{basketgroupname};
2151 my $budget = $params{budget};
2152 my $orderstatus = $params{orderstatus};
2153 my $biblionumber = $params{biblionumber};
2154 my $get_canceled_order = $params{get_canceled_order} || 0;
2155 my $ordernumber = $params{ordernumber};
2156 my $search_children_too = $params{search_children_too} || 0;
2157 my $created_by = $params{created_by} || [];
2161 my $total_qtyreceived = 0;
2162 my $total_price = 0;
2164 my $dbh = C4::Context->dbh;
2167 COALESCE(biblio.title, deletedbiblio.title) AS title,
2168 COALESCE(biblio.author, deletedbiblio.author) AS author,
2169 COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2170 COALESCE(biblioitems.ean, deletedbiblioitems.ean) AS ean,
2172 aqbasket.basketname,
2173 aqbasket.basketgroupid,
2174 aqbasket.authorisedby,
2175 concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2176 aqbasketgroups.name as groupname,
2178 aqbasket.creationdate,
2179 aqorders.datereceived,
2181 aqorders.quantityreceived,
2183 aqorders.ordernumber,
2185 aqinvoices.invoicenumber,
2186 aqbooksellers.id as id,
2187 aqorders.biblionumber,
2188 aqorders.orderstatus,
2189 aqorders.parent_ordernumber,
2190 aqbudgets.budget_name
2192 $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2195 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2196 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2197 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2198 LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2199 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2200 LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2201 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2202 LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2203 LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2204 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2207 $query .= " WHERE 1 ";
2209 unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2210 $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2213 my @query_params = ();
2215 if ( $biblionumber ) {
2216 $query .= " AND biblio.biblionumber = ?";
2217 push @query_params, $biblionumber;
2221 $query .= " AND biblio.title LIKE ? ";
2222 $title =~ s/\s+/%/g;
2223 push @query_params, "%$title%";
2227 $query .= " AND biblio.author LIKE ? ";
2228 push @query_params, "%$author%";
2232 $query .= " AND biblioitems.isbn LIKE ? ";
2233 push @query_params, "%$isbn%";
2236 $query .= " AND biblioitems.ean = ? ";
2237 push @query_params, "$ean";
2240 $query .= " AND aqbooksellers.name LIKE ? ";
2241 push @query_params, "%$name%";
2245 $query .= " AND aqbudgets.budget_id = ? ";
2246 push @query_params, "$budget";
2249 if ( $from_placed_on ) {
2250 $query .= " AND creationdate >= ? ";
2251 push @query_params, $from_placed_on;
2254 if ( $to_placed_on ) {
2255 $query .= " AND creationdate <= ? ";
2256 push @query_params, $to_placed_on;
2259 if ( defined $orderstatus and $orderstatus ne '') {
2260 $query .= " AND aqorders.orderstatus = ? ";
2261 push @query_params, "$orderstatus";
2265 if ($basket =~ m/^\d+$/) {
2266 $query .= " AND aqorders.basketno = ? ";
2267 push @query_params, $basket;
2269 $query .= " AND aqbasket.basketname LIKE ? ";
2270 push @query_params, "%$basket%";
2274 if ($booksellerinvoicenumber) {
2275 $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2276 push @query_params, "%$booksellerinvoicenumber%";
2279 if ($basketgroupname) {
2280 $query .= " AND aqbasketgroups.name LIKE ? ";
2281 push @query_params, "%$basketgroupname%";
2285 $query .= " AND (aqorders.ordernumber = ? ";
2286 push @query_params, $ordernumber;
2287 if ($search_children_too) {
2288 $query .= " OR aqorders.parent_ordernumber = ? ";
2289 push @query_params, $ordernumber;
2294 if ( @$created_by ) {
2295 $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2296 push @query_params, @$created_by;
2300 if ( C4::Context->preference("IndependentBranches") ) {
2301 unless ( C4::Context->IsSuperLibrarian() ) {
2302 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2303 push @query_params, C4::Context->userenv->{branch};
2306 $query .= " ORDER BY id";
2308 return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2311 =head2 GetRecentAcqui
2313 $results = GetRecentAcqui($days);
2315 C<$results> is a ref to a table which containts hashref
2319 sub GetRecentAcqui {
2321 my $dbh = C4::Context->dbh;
2325 ORDER BY timestamp DESC
2328 my $sth = $dbh->prepare($query);
2330 my $results = $sth->fetchall_arrayref({});
2334 #------------------------------------------------------------#
2338 &AddClaim($ordernumber);
2340 Add a claim for an order
2345 my ($ordernumber) = @_;
2346 my $dbh = C4::Context->dbh;
2349 claims_count = claims_count + 1,
2350 claimed_date = CURDATE()
2351 WHERE ordernumber = ?
2353 my $sth = $dbh->prepare($query);
2354 $sth->execute($ordernumber);
2359 my @invoices = GetInvoices(
2360 invoicenumber => $invoicenumber,
2361 supplierid => $supplierid,
2362 suppliername => $suppliername,
2363 shipmentdatefrom => $shipmentdatefrom, # ISO format
2364 shipmentdateto => $shipmentdateto, # ISO format
2365 billingdatefrom => $billingdatefrom, # ISO format
2366 billingdateto => $billingdateto, # ISO format
2367 isbneanissn => $isbn_or_ean_or_issn,
2370 publisher => $publisher,
2371 publicationyear => $publicationyear,
2372 branchcode => $branchcode,
2373 order_by => $order_by
2376 Return a list of invoices that match all given criteria.
2378 $order_by is "column_name (asc|desc)", where column_name is any of
2379 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2380 'shipmentcost', 'shipmentcost_budgetid'.
2382 asc is the default if omitted
2389 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2390 closedate shipmentcost shipmentcost_budgetid);
2392 my $dbh = C4::Context->dbh;
2394 SELECT aqinvoices.*, aqbooksellers.name AS suppliername,
2397 aqorders.datereceived IS NOT NULL,
2398 aqorders.biblionumber,
2401 ) AS receivedbiblios,
2404 aqorders.subscriptionid IS NOT NULL,
2405 aqorders.subscriptionid,
2408 ) AS is_linked_to_subscriptions,
2409 SUM(aqorders.quantityreceived) AS receiveditems
2411 LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2412 LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2413 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2414 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2415 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2416 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2417 LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2422 if($args{supplierid}) {
2423 push @bind_strs, " aqinvoices.booksellerid = ? ";
2424 push @bind_args, $args{supplierid};
2426 if($args{invoicenumber}) {
2427 push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2428 push @bind_args, "%$args{invoicenumber}%";
2430 if($args{suppliername}) {
2431 push @bind_strs, " aqbooksellers.name LIKE ? ";
2432 push @bind_args, "%$args{suppliername}%";
2434 if($args{shipmentdatefrom}) {
2435 push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2436 push @bind_args, $args{shipmentdatefrom};
2438 if($args{shipmentdateto}) {
2439 push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2440 push @bind_args, $args{shipmentdateto};
2442 if($args{billingdatefrom}) {
2443 push @bind_strs, " aqinvoices.billingdate >= ? ";
2444 push @bind_args, $args{billingdatefrom};
2446 if($args{billingdateto}) {
2447 push @bind_strs, " aqinvoices.billingdate <= ? ";
2448 push @bind_args, $args{billingdateto};
2450 if($args{isbneanissn}) {
2451 push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2452 push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2455 push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2456 push @bind_args, $args{title};
2459 push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2460 push @bind_args, $args{author};
2462 if($args{publisher}) {
2463 push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2464 push @bind_args, $args{publisher};
2466 if($args{publicationyear}) {
2467 push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2468 push @bind_args, $args{publicationyear}, $args{publicationyear};
2470 if($args{branchcode}) {
2471 push @bind_strs, " borrowers.branchcode = ? ";
2472 push @bind_args, $args{branchcode};
2475 $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2476 $query .= " GROUP BY aqinvoices.invoiceid ";
2478 if($args{order_by}) {
2479 my ($column, $direction) = split / /, $args{order_by};
2480 if(grep /^$column$/, @columns) {
2481 $direction ||= 'ASC';
2482 $query .= " ORDER BY $column $direction";
2486 my $sth = $dbh->prepare($query);
2487 $sth->execute(@bind_args);
2489 my $results = $sth->fetchall_arrayref({});
2495 my $invoice = GetInvoice($invoiceid);
2497 Get informations about invoice with given $invoiceid
2499 Return a hash filled with aqinvoices.* fields
2504 my ($invoiceid) = @_;
2507 return unless $invoiceid;
2509 my $dbh = C4::Context->dbh;
2515 my $sth = $dbh->prepare($query);
2516 $sth->execute($invoiceid);
2518 $invoice = $sth->fetchrow_hashref;
2522 =head3 GetInvoiceDetails
2524 my $invoice = GetInvoiceDetails($invoiceid)
2526 Return informations about an invoice + the list of related order lines
2528 Orders informations are in $invoice->{orders} (array ref)
2532 sub GetInvoiceDetails {
2533 my ($invoiceid) = @_;
2535 if ( !defined $invoiceid ) {
2536 carp 'GetInvoiceDetails called without an invoiceid';
2540 my $dbh = C4::Context->dbh;
2542 SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2544 LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2547 my $sth = $dbh->prepare($query);
2548 $sth->execute($invoiceid);
2550 my $invoice = $sth->fetchrow_hashref;
2555 biblio.copyrightdate,
2556 biblioitems.publishercode,
2557 biblioitems.publicationyear,
2558 aqbasket.basketname,
2559 aqbasketgroups.id AS basketgroupid,
2560 aqbasketgroups.name AS basketgroupname
2562 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2563 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2564 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2565 LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2568 $sth = $dbh->prepare($query);
2569 $sth->execute($invoiceid);
2570 $invoice->{orders} = $sth->fetchall_arrayref({});
2571 $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2578 my $invoiceid = AddInvoice(
2579 invoicenumber => $invoicenumber,
2580 booksellerid => $booksellerid,
2581 shipmentdate => $shipmentdate,
2582 billingdate => $billingdate,
2583 closedate => $closedate,
2584 shipmentcost => $shipmentcost,
2585 shipmentcost_budgetid => $shipmentcost_budgetid
2588 Create a new invoice and return its id or undef if it fails.
2595 return unless(%invoice and $invoice{invoicenumber});
2597 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2598 closedate shipmentcost shipmentcost_budgetid);
2602 foreach my $key (keys %invoice) {
2603 if(0 < grep(/^$key$/, @columns)) {
2604 push @set_strs, "$key = ?";
2605 push @set_args, ($invoice{$key} || undef);
2611 my $dbh = C4::Context->dbh;
2612 my $query = "INSERT INTO aqinvoices SET ";
2613 $query .= join (",", @set_strs);
2614 my $sth = $dbh->prepare($query);
2615 $rv = $sth->execute(@set_args);
2617 $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2626 invoiceid => $invoiceid, # Mandatory
2627 invoicenumber => $invoicenumber,
2628 booksellerid => $booksellerid,
2629 shipmentdate => $shipmentdate,
2630 billingdate => $billingdate,
2631 closedate => $closedate,
2632 shipmentcost => $shipmentcost,
2633 shipmentcost_budgetid => $shipmentcost_budgetid
2636 Modify an invoice, invoiceid is mandatory.
2638 Return undef if it fails.
2645 return unless(%invoice and $invoice{invoiceid});
2647 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2648 closedate shipmentcost shipmentcost_budgetid);
2652 foreach my $key (keys %invoice) {
2653 if(0 < grep(/^$key$/, @columns)) {
2654 push @set_strs, "$key = ?";
2655 push @set_args, ($invoice{$key} || undef);
2659 my $dbh = C4::Context->dbh;
2660 my $query = "UPDATE aqinvoices SET ";
2661 $query .= join(",", @set_strs);
2662 $query .= " WHERE invoiceid = ?";
2664 my $sth = $dbh->prepare($query);
2665 $sth->execute(@set_args, $invoice{invoiceid});
2670 CloseInvoice($invoiceid);
2674 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2679 my ($invoiceid) = @_;
2681 return unless $invoiceid;
2683 my $dbh = C4::Context->dbh;
2686 SET closedate = CAST(NOW() AS DATE)
2689 my $sth = $dbh->prepare($query);
2690 $sth->execute($invoiceid);
2693 =head3 ReopenInvoice
2695 ReopenInvoice($invoiceid);
2699 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2704 my ($invoiceid) = @_;
2706 return unless $invoiceid;
2708 my $dbh = C4::Context->dbh;
2711 SET closedate = NULL
2714 my $sth = $dbh->prepare($query);
2715 $sth->execute($invoiceid);
2720 DelInvoice($invoiceid);
2722 Delete an invoice if there are no items attached to it.
2727 my ($invoiceid) = @_;
2729 return unless $invoiceid;
2731 my $dbh = C4::Context->dbh;
2737 my $sth = $dbh->prepare($query);
2738 $sth->execute($invoiceid);
2739 my $res = $sth->fetchrow_arrayref;
2740 if ( $res && $res->[0] == 0 ) {
2742 DELETE FROM aqinvoices
2745 my $sth = $dbh->prepare($query);
2746 return ( $sth->execute($invoiceid) > 0 );
2751 =head3 MergeInvoices
2753 MergeInvoices($invoiceid, \@sourceids);
2755 Merge the invoices identified by the IDs in \@sourceids into
2756 the invoice identified by $invoiceid.
2761 my ($invoiceid, $sourceids) = @_;
2763 return unless $invoiceid;
2764 foreach my $sourceid (@$sourceids) {
2765 next if $sourceid == $invoiceid;
2766 my $source = GetInvoiceDetails($sourceid);
2767 foreach my $order (@{$source->{'orders'}}) {
2768 $order->{'invoiceid'} = $invoiceid;
2771 DelInvoice($source->{'invoiceid'});
2776 =head3 GetBiblioCountByBasketno
2778 $biblio_count = &GetBiblioCountByBasketno($basketno);
2780 Looks up the biblio's count that has basketno value $basketno
2786 sub GetBiblioCountByBasketno {
2787 my ($basketno) = @_;
2788 my $dbh = C4::Context->dbh;
2790 SELECT COUNT( DISTINCT( biblionumber ) )
2793 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
2796 my $sth = $dbh->prepare($query);
2797 $sth->execute($basketno);
2798 return $sth->fetchrow;
2801 # This is *not* the good way to calcul prices
2802 # But it's how it works at the moment into Koha
2803 # This will be fixed later.
2804 # Note this subroutine should be moved to Koha::Acquisition::Order
2805 # Will do when a DBIC decision will be taken.
2806 sub populate_order_with_prices {
2809 my $order = $params->{order};
2810 my $booksellerid = $params->{booksellerid};
2811 return unless $booksellerid;
2813 my $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid });
2815 my $receiving = $params->{receiving};
2816 my $ordering = $params->{ordering};
2817 my $discount = $order->{discount};
2818 $discount /= 100 if $discount > 1;
2820 $order->{rrp} = Koha::Number::Price->new( $order->{rrp} )->round;
2821 $order->{ecost} = Koha::Number::Price->new( $order->{ecost} )->round;
2823 if ( $bookseller->{listincgst} ) {
2824 $order->{rrpgsti} = $order->{rrp};
2825 $order->{rrpgste} = Koha::Number::Price->new(
2826 $order->{rrpgsti} / ( 1 + $order->{gstrate} ) )->round;
2827 $order->{ecostgsti} = $order->{ecost};
2828 $order->{ecostgste} = Koha::Number::Price->new(
2829 $order->{ecost} / ( 1 + $order->{gstrate} ) )->round;
2830 $order->{gstvalue} = Koha::Number::Price->new(
2831 ( $order->{ecostgsti} - $order->{ecostgste} ) *
2832 $order->{quantity} )->round;
2833 $order->{totalgste} = $order->{ecostgste} * $order->{quantity};
2834 $order->{totalgsti} = $order->{ecostgsti} * $order->{quantity};
2837 $order->{rrpgste} = $order->{rrp};
2838 $order->{rrpgsti} = Koha::Number::Price->new(
2839 $order->{rrp} * ( 1 + $order->{gstrate} ) )->round;
2840 $order->{ecostgste} = $order->{ecost};
2841 $order->{ecostgsti} = Koha::Number::Price->new(
2842 $order->{ecost} * ( 1 + $order->{gstrate} ) )->round;
2843 $order->{gstvalue} = Koha::Number::Price->new(
2844 ( $order->{ecostgsti} - $order->{ecostgste} ) *
2845 $order->{quantity} )->round;
2846 $order->{totalgste} = $order->{ecostgste} * $order->{quantity};
2847 $order->{totalgsti} = $order->{ecostgsti} * $order->{quantity};
2852 if ( $bookseller->{listincgst} ) {
2853 $order->{unitpricegsti} = Koha::Number::Price->new( $order->{unitprice} )->round;
2854 $order->{unitpricegste} = Koha::Number::Price->new(
2855 $order->{unitpricegsti} / ( 1 + $order->{gstrate} ) )->round;
2858 $order->{unitpricegste} = Koha::Number::Price->new( $order->{unitprice} )->round;
2859 $order->{unitpricegsti} = Koha::Number::Price->new(
2860 $order->{unitpricegste} * ( 1 + $order->{gstrate} ) )->round;
2862 $order->{gstvalue} = Koha::Number::Price->new(
2863 ( $order->{unitpricegsti} - $order->{unitpricegste} )
2864 * $order->{quantityreceived} )->round;
2866 $order->{totalgste} = $order->{unitpricegste} * $order->{quantity};
2867 $order->{totalgsti} = $order->{unitpricegsti} * $order->{quantity};
2873 =head3 GetOrderUsers
2875 $order_users_ids = &GetOrderUsers($ordernumber);
2877 Returns a list of all borrowernumbers that are in order users list
2882 my ($ordernumber) = @_;
2884 return unless $ordernumber;
2887 SELECT borrowernumber
2889 WHERE ordernumber = ?
2891 my $dbh = C4::Context->dbh;
2892 my $sth = $dbh->prepare($query);
2893 $sth->execute($ordernumber);
2894 my $results = $sth->fetchall_arrayref( {} );
2896 my @borrowernumbers;
2897 foreach (@$results) {
2898 push @borrowernumbers, $_->{'borrowernumber'};
2901 return @borrowernumbers;
2904 =head3 ModOrderUsers
2906 my @order_users_ids = (1, 2, 3);
2907 &ModOrderUsers($ordernumber, @basketusers_ids);
2909 Delete all users from order users list, and add users in C<@order_users_ids>
2915 my ( $ordernumber, @order_users_ids ) = @_;
2917 return unless $ordernumber;
2919 my $dbh = C4::Context->dbh;
2921 DELETE FROM aqorder_users
2922 WHERE ordernumber = ?
2924 my $sth = $dbh->prepare($query);
2925 $sth->execute($ordernumber);
2928 INSERT INTO aqorder_users (ordernumber, borrowernumber)
2931 $sth = $dbh->prepare($query);
2932 foreach my $order_user_id (@order_users_ids) {
2933 $sth->execute( $ordernumber, $order_user_id );
2937 sub NotifyOrderUsers {
2938 my ($ordernumber) = @_;
2940 my @borrowernumbers = GetOrderUsers($ordernumber);
2941 return unless @borrowernumbers;
2943 my $order = GetOrder( $ordernumber );
2944 for my $borrowernumber (@borrowernumbers) {
2945 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
2946 my $branch = C4::Branch::GetBranchDetail( $borrower->{branchcode} );
2947 my $biblio = C4::Biblio::GetBiblio( $order->{biblionumber} );
2948 my $letter = C4::Letters::GetPreparedLetter(
2949 module => 'acquisition',
2950 letter_code => 'ACQ_NOTIF_ON_RECEIV',
2951 branchcode => $branch->{branchcode},
2953 'branches' => $branch,
2954 'borrowers' => $borrower,
2955 'biblio' => $biblio,
2956 'aqorders' => $order,
2960 C4::Letters::EnqueueLetter(
2963 borrowernumber => $borrowernumber,
2964 LibraryName => C4::Context->preference("LibraryName"),
2965 message_transport_type => 'email',
2967 ) or warn "can't enqueue letter $letter";
2972 =head3 FillWithDefaultValues
2974 FillWithDefaultValues( $marc_record );
2976 This will update the record with default value defined in the ACQ framework.
2977 For all existing fields, if a default value exists and there are no subfield, it will be created.
2978 If the field does not exist, it will be created too.
2982 sub FillWithDefaultValues {
2984 my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ' );
2987 C4::Biblio::GetMarcFromKohaField( 'items.itemnumber', '' );
2988 for my $tag ( sort keys %$tagslib ) {
2990 next if $tag == $itemfield;
2991 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
2992 next if ( subfield_is_koha_internal_p($subfield) );
2993 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
2994 if ( defined $defaultvalue and $defaultvalue ne '' ) {
2995 my @fields = $record->field($tag);
2997 for my $field (@fields) {
2998 unless ( defined $field->subfield($subfield) ) {
2999 $field->add_subfields(
3000 $subfield => $defaultvalue );
3005 $record->insert_fields_ordered(
3007 $tag, '', '', $subfield => $defaultvalue
3022 Koha Development Team <http://koha-community.org/>