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
66 &GetLastOrderNotReceivedFromSubscriptionid &GetLastOrderReceivedFromSubscriptionid
81 &GetItemnumbersFromOrder
84 &GetBiblioCountByBasketno
96 sub GetOrderFromItemnumber
{
97 my ($itemnumber) = @_;
98 my $dbh = C4
::Context
->dbh;
101 SELECT
* from aqorders LEFT JOIN aqorders_items
102 ON
( aqorders
.ordernumber
= aqorders_items
.ordernumber
)
103 WHERE itemnumber
= ?
|;
105 my $sth = $dbh->prepare($query);
109 $sth->execute($itemnumber);
111 my $order = $sth->fetchrow_hashref;
116 # Returns the itemnumber(s) associated with the ordernumber given in parameter
117 sub GetItemnumbersFromOrder
{
118 my ($ordernumber) = @_;
119 my $dbh = C4
::Context
->dbh;
120 my $query = "SELECT itemnumber FROM aqorders_items WHERE ordernumber=?";
121 my $sth = $dbh->prepare($query);
122 $sth->execute($ordernumber);
125 while (my $order = $sth->fetchrow_hashref) {
126 push @tab, $order->{'itemnumber'};
140 C4::Acquisition - Koha functions for dealing with orders and acquisitions
148 The functions in this module deal with acquisitions, managing book
149 orders, basket and parcels.
153 =head2 FUNCTIONS ABOUT BASKETS
157 $aqbasket = &GetBasket($basketnumber);
159 get all basket informations in aqbasket for a given basket
161 B<returns:> informations for a given basket returned as a hashref.
167 my $dbh = C4
::Context
->dbh;
170 concat( b.firstname,' ',b.surname) AS authorisedbyname
172 LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
175 my $sth=$dbh->prepare($query);
176 $sth->execute($basketno);
177 my $basket = $sth->fetchrow_hashref;
181 #------------------------------------------------------------#
185 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
186 $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace );
188 Create a new basket in aqbasket table
192 =item C<$booksellerid> is a foreign key in the aqbasket table
194 =item C<$authorizedby> is the username of who created the basket
198 The other parameters are optional, see ModBasketHeader for more info on them.
203 my ( $booksellerid, $authorisedby, $basketname, $basketnote,
204 $basketbooksellernote, $basketcontractnumber, $deliveryplace,
205 $billingplace ) = @_;
206 my $dbh = C4
::Context
->dbh;
208 'INSERT INTO aqbasket (creationdate,booksellerid,authorisedby) '
209 . 'VALUES (now(),?,?)';
210 $dbh->do( $query, {}, $booksellerid, $authorisedby );
212 my $basket = $dbh->{mysql_insertid
};
213 $basketname ||= q{}; # default to empty strings
215 $basketbooksellernote ||= q{};
216 ModBasketHeader
( $basket, $basketname, $basketnote, $basketbooksellernote,
217 $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace );
221 #------------------------------------------------------------#
225 &CloseBasket($basketno);
227 close a basket (becomes unmodifiable, except for receives)
233 my $dbh = C4
::Context
->dbh;
239 my $sth = $dbh->prepare($query);
240 $sth->execute($basketno);
242 my @orders = GetOrders
($basketno);
243 foreach my $order (@orders) {
246 SET orderstatus
= 'ordered'
247 WHERE ordernumber
= ?
;
249 $sth = $dbh->prepare($query);
250 $sth->execute($order->{'ordernumber'});
256 &ReopenBasket($basketno);
264 my $dbh = C4
::Context
->dbh;
270 my $sth = $dbh->prepare($query);
271 $sth->execute($basketno);
273 my @orders = GetOrders
($basketno);
274 foreach my $order (@orders) {
277 SET orderstatus
= 'new'
278 WHERE ordernumber
= ?
;
280 $sth = $dbh->prepare($query);
281 $sth->execute($order->{'ordernumber'});
285 #------------------------------------------------------------#
287 =head3 GetBasketAsCSV
289 &GetBasketAsCSV($basketno);
291 Export a basket as CSV
293 $cgi parameter is needed for column name translation
298 my ($basketno, $cgi) = @_;
299 my $basket = GetBasket
($basketno);
300 my @orders = GetOrders
($basketno);
301 my $contract = GetContract
({
302 contractnumber
=> $basket->{'contractnumber'}
305 my $template = C4
::Templates
::gettemplate
("acqui/csv/basket.tt", "intranet", $cgi);
308 foreach my $order (@orders) {
309 my $bd = GetBiblioData
( $order->{'biblionumber'} );
311 contractname
=> $contract->{'contractname'},
312 ordernumber
=> $order->{'ordernumber'},
313 entrydate
=> $order->{'entrydate'},
314 isbn
=> $order->{'isbn'},
315 author
=> $bd->{'author'},
316 title
=> $bd->{'title'},
317 publicationyear
=> $bd->{'publicationyear'},
318 publishercode
=> $bd->{'publishercode'},
319 collectiontitle
=> $bd->{'collectiontitle'},
320 notes
=> $order->{'order_vendornote'},
321 quantity
=> $order->{'quantity'},
322 rrp
=> $order->{'rrp'},
323 deliveryplace
=> C4
::Branch
::GetBranchName
( $basket->{'deliveryplace'} ),
324 billingplace
=> C4
::Branch
::GetBranchName
( $basket->{'billingplace'} ),
327 contractname author title publishercode collectiontitle notes
328 deliveryplace billingplace
330 # Double the quotes to not be interpreted as a field end
331 $row->{$_} =~ s/"/""/g if $row->{$_};
337 if(defined $a->{publishercode
} and defined $b->{publishercode
}) {
338 $a->{publishercode
} cmp $b->{publishercode
};
342 $template->param(rows
=> \
@rows);
344 return $template->output;
348 =head3 GetBasketGroupAsCSV
350 &GetBasketGroupAsCSV($basketgroupid);
352 Export a basket group as CSV
354 $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( $basketno, { orderby => 'biblio.title', cancelled => 0|1 } );
1041 Looks up the pending (non-cancelled) orders with the given basket
1044 If cancelled is set, only cancelled orders will be returned.
1049 my ( $basketno, $params ) = @_;
1051 return () unless $basketno;
1053 my $orderby = $params->{orderby
};
1054 my $cancelled = $params->{cancelled
} || 0;
1056 my $dbh = C4
::Context
->dbh;
1058 SELECT biblio
.*,biblioitems
.*,
1062 $query .= $cancelled
1064 aqorders_transfers
.ordernumber_to AS transferred_to
,
1065 aqorders_transfers
.timestamp AS transferred_to_timestamp
1068 aqorders_transfers
.ordernumber_from AS transferred_from
,
1069 aqorders_transfers
.timestamp AS transferred_from_timestamp
1073 LEFT JOIN aqbudgets ON aqbudgets
.budget_id
= aqorders
.budget_id
1074 LEFT JOIN biblio ON biblio
.biblionumber
= aqorders
.biblionumber
1075 LEFT JOIN biblioitems ON biblioitems
.biblionumber
=biblio
.biblionumber
1077 $query .= $cancelled
1079 LEFT JOIN aqorders_transfers ON aqorders_transfers
.ordernumber_from
= aqorders
.ordernumber
1082 LEFT JOIN aqorders_transfers ON aqorders_transfers
.ordernumber_to
= aqorders
.ordernumber
1090 $orderby ||= q
|biblioitems
.publishercode
, biblio
.title
|;
1092 AND
(datecancellationprinted IS NOT NULL
1093 AND datecancellationprinted
<> '0000-00-00')
1098 q
|aqorders
.datecancellationprinted desc
, aqorders
.timestamp desc
|;
1100 AND
(datecancellationprinted IS NULL OR datecancellationprinted
='0000-00-00')
1104 $query .= " ORDER BY $orderby";
1106 $dbh->selectall_arrayref( $query, { Slice
=> {} }, $basketno );
1111 #------------------------------------------------------------#
1113 =head3 GetOrdersByBiblionumber
1115 @orders = &GetOrdersByBiblionumber($biblionumber);
1117 Looks up the orders with linked to a specific $biblionumber, including
1118 cancelled orders and received orders.
1121 C<@orders> is an array of references-to-hash, whose keys are the
1122 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
1126 sub GetOrdersByBiblionumber
{
1127 my $biblionumber = shift;
1128 return unless $biblionumber;
1129 my $dbh = C4
::Context
->dbh;
1131 SELECT biblio.*,biblioitems.*,
1135 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1136 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1137 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1138 WHERE aqorders.biblionumber=?
1141 $dbh->selectall_arrayref( $query, { Slice
=> {} }, $biblionumber );
1142 return @
{$result_set};
1146 #------------------------------------------------------------#
1150 $order = &GetOrder($ordernumber);
1152 Looks up an order by order number.
1154 Returns a reference-to-hash describing the order. The keys of
1155 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1160 my ($ordernumber) = @_;
1161 return unless $ordernumber;
1163 my $dbh = C4
::Context
->dbh;
1164 my $query = qq{SELECT
1168 aqbasket
.basketname
,
1169 borrowers
.branchcode
,
1170 biblioitems
.publicationyear
,
1171 biblio
.copyrightdate
,
1172 biblioitems
.editionstatement
,
1176 biblioitems
.publishercode
,
1177 aqorders
.rrp AS unitpricesupplier
,
1178 aqorders
.ecost AS unitpricelib
,
1179 aqorders
.claims_count AS claims_count
,
1180 aqorders
.claimed_date AS claimed_date
,
1181 aqbudgets
.budget_name AS budget
,
1182 aqbooksellers
.name AS supplier
,
1183 aqbooksellers
.id AS supplierid
,
1184 biblioitems
.publishercode AS publisher
,
1185 ADDDATE
(aqbasket
.closedate
, INTERVAL aqbooksellers
.deliverytime DAY
) AS estimateddeliverydate
,
1186 DATE
(aqbasket
.closedate
) AS orderdate
,
1187 aqorders
.quantity
- COALESCE
(aqorders
.quantityreceived
,0) AS quantity_to_receive
,
1188 (aqorders
.quantity
- COALESCE
(aqorders
.quantityreceived
,0)) * aqorders
.rrp AS subtotal
,
1189 DATEDIFF
(CURDATE
( ),closedate
) AS latesince
1190 FROM aqorders LEFT JOIN biblio ON biblio
.biblionumber
= aqorders
.biblionumber
1191 LEFT JOIN biblioitems ON biblioitems
.biblionumber
= biblio
.biblionumber
1192 LEFT JOIN aqbudgets ON aqorders
.budget_id
= aqbudgets
.budget_id
,
1193 aqbasket LEFT JOIN borrowers ON aqbasket
.authorisedby
= borrowers
.borrowernumber
1194 LEFT JOIN aqbooksellers ON aqbasket
.booksellerid
= aqbooksellers
.id
1195 WHERE aqorders
.basketno
= aqbasket
.basketno
1198 $dbh->selectall_arrayref( $query, { Slice
=> {} }, $ordernumber );
1200 # result_set assumed to contain 1 match
1201 return $result_set->[0];
1204 =head3 GetLastOrderNotReceivedFromSubscriptionid
1206 $order = &GetLastOrderNotReceivedFromSubscriptionid($subscriptionid);
1208 Returns a reference-to-hash describing the last order not received for a subscription.
1212 sub GetLastOrderNotReceivedFromSubscriptionid
{
1213 my ( $subscriptionid ) = @_;
1214 my $dbh = C4
::Context
->dbh;
1216 SELECT
* FROM aqorders
1217 LEFT JOIN subscription
1218 ON
( aqorders
.subscriptionid
= subscription
.subscriptionid
)
1219 WHERE aqorders
.subscriptionid
= ?
1220 AND aqorders
.datereceived IS NULL
1224 $dbh->selectall_arrayref( $query, { Slice
=> {} }, $subscriptionid );
1226 # result_set assumed to contain 1 match
1227 return $result_set->[0];
1230 =head3 GetLastOrderReceivedFromSubscriptionid
1232 $order = &GetLastOrderReceivedFromSubscriptionid($subscriptionid);
1234 Returns a reference-to-hash describing the last order received for a subscription.
1238 sub GetLastOrderReceivedFromSubscriptionid
{
1239 my ( $subscriptionid ) = @_;
1240 my $dbh = C4
::Context
->dbh;
1242 SELECT
* FROM aqorders
1243 LEFT JOIN subscription
1244 ON
( aqorders
.subscriptionid
= subscription
.subscriptionid
)
1245 WHERE aqorders
.subscriptionid
= ?
1246 AND aqorders
.datereceived
=
1248 SELECT MAX
( aqorders
.datereceived
)
1250 LEFT JOIN subscription
1251 ON
( aqorders
.subscriptionid
= subscription
.subscriptionid
)
1252 WHERE aqorders
.subscriptionid
= ?
1253 AND aqorders
.datereceived IS NOT NULL
1255 ORDER BY ordernumber DESC
1259 $dbh->selectall_arrayref( $query, { Slice
=> {} }, $subscriptionid, $subscriptionid );
1261 # result_set assumed to contain 1 match
1262 return $result_set->[0];
1266 #------------------------------------------------------------#
1270 &ModOrder(\%hashref);
1272 Modifies an existing order. Updates the order with order number
1273 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1274 other keys of the hash update the fields with the same name in the aqorders
1275 table of the Koha database.
1280 my $orderinfo = shift;
1282 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '' ;
1283 die "Biblionumber is required" if $orderinfo->{'biblionumber'} eq '';
1285 my $dbh = C4
::Context
->dbh;
1288 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1289 $orderinfo->{uncertainprice
}=1 if $orderinfo->{uncertainprice
};
1291 # delete($orderinfo->{'branchcode'});
1292 # the hash contains a lot of entries not in aqorders, so get the columns ...
1293 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1295 my $colnames = $sth->{NAME
};
1296 #FIXME Be careful. If aqorders would have columns with diacritics,
1297 #you should need to decode what you get back from NAME.
1298 #See report 10110 and guided_reports.pl
1299 my $query = "UPDATE aqorders SET ";
1301 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1302 # ... and skip hash entries that are not in the aqorders table
1303 # FIXME : probably not the best way to do it (would be better to have a correct hash)
1304 next unless grep(/^$orderinfokey$/, @
$colnames);
1305 $query .= "$orderinfokey=?, ";
1306 push(@params, $orderinfo->{$orderinfokey});
1309 $query .= "timestamp=NOW() WHERE ordernumber=?";
1310 push(@params, $orderinfo->{'ordernumber'} );
1311 $sth = $dbh->prepare($query);
1312 $sth->execute(@params);
1316 #------------------------------------------------------------#
1320 ModItemOrder($itemnumber, $ordernumber);
1322 Modifies the ordernumber of an item in aqorders_items.
1327 my ($itemnumber, $ordernumber) = @_;
1329 return unless ($itemnumber and $ordernumber);
1331 my $dbh = C4
::Context
->dbh;
1333 UPDATE aqorders_items
1335 WHERE itemnumber
= ?
1337 my $sth = $dbh->prepare($query);
1338 return $sth->execute($ordernumber, $itemnumber);
1341 #------------------------------------------------------------#
1343 =head3 ModReceiveOrder
1346 biblionumber => $biblionumber,
1347 ordernumber => $ordernumber,
1348 quantityreceived => $quantityreceived,
1352 invoiceid => $invoiceid,
1354 budget_id => $budget_id,
1355 datereceived => $datereceived,
1356 received_itemnumbers => \@received_itemnumbers,
1357 order_internalnote => $order_internalnote,
1358 order_vendornote => $order_vendornote,
1361 Updates an order, to reflect the fact that it was received, at least
1362 in part. All arguments not mentioned below update the fields with the
1363 same name in the aqorders table of the Koha database.
1365 If a partial order is received, splits the order into two.
1367 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1373 sub ModReceiveOrder
{
1374 my ( $params ) = @_;
1375 my $biblionumber = $params->{biblionumber
};
1376 my $ordernumber = $params->{ordernumber
};
1377 my $quantrec = $params->{quantityreceived
};
1378 my $user = $params->{user
};
1379 my $cost = $params->{cost
};
1380 my $ecost = $params->{ecost
};
1381 my $invoiceid = $params->{invoiceid
};
1382 my $rrp = $params->{rrp
};
1383 my $budget_id = $params->{budget_id
};
1384 my $datereceived = $params->{datereceived
};
1385 my $received_items = $params->{received_items
};
1386 my $order_internalnote = $params->{order_internalnote
};
1387 my $order_vendornote = $params->{order_vendornote
};
1389 my $dbh = C4
::Context
->dbh;
1390 $datereceived = C4
::Dates
->output('iso') unless $datereceived;
1391 my $suggestionid = GetSuggestionFromBiblionumber
( $biblionumber );
1392 if ($suggestionid) {
1393 ModSuggestion
( {suggestionid
=>$suggestionid,
1394 STATUS
=>'AVAILABLE',
1395 biblionumber
=> $biblionumber}
1399 my $result_set = $dbh->selectall_arrayref(
1400 q{SELECT * FROM aqorders WHERE biblionumber=? AND aqorders.ordernumber=?},
1401 { Slice
=> {} }, $biblionumber, $ordernumber
1404 # we assume we have a unique order
1405 my $order = $result_set->[0];
1407 my $new_ordernumber = $ordernumber;
1408 if ( $order->{quantity
} > $quantrec ) {
1409 # Split order line in two parts: the first is the original order line
1410 # without received items (the quantity is decreased),
1411 # the second part is a new order line with quantity=quantityrec
1412 # (entirely received)
1416 orderstatus
= 'partial'|;
1417 $query .= q
|, order_internalnote
= ?
| if defined $order_internalnote;
1418 $query .= q
|, order_vendornote
= ?
| if defined $order_vendornote;
1419 $query .= q
| WHERE ordernumber
= ?
|;
1420 my $sth = $dbh->prepare($query);
1423 $order->{quantity
} - $quantrec,
1424 ( defined $order_internalnote ?
$order_internalnote : () ),
1425 ( defined $order_vendornote ?
$order_vendornote : () ),
1429 delete $order->{'ordernumber'};
1430 $order->{'budget_id'} = ( $budget_id || $order->{'budget_id'} );
1431 $order->{'quantity'} = $quantrec;
1432 $order->{'quantityreceived'} = $quantrec;
1433 $order->{'datereceived'} = $datereceived;
1434 $order->{'invoiceid'} = $invoiceid;
1435 $order->{'unitprice'} = $cost;
1436 $order->{'rrp'} = $rrp;
1437 $order->{ecost
} = $ecost;
1438 $order->{'orderstatus'} = 'complete';
1439 $new_ordernumber = Koha
::Acquisition
::Order
->new($order)->insert->{ordernumber
};
1441 if ($received_items) {
1442 foreach my $itemnumber (@
$received_items) {
1443 ModItemOrder
($itemnumber, $new_ordernumber);
1449 set quantityreceived
=?
,datereceived
=?
,invoiceid
=?
,
1450 unitprice
=?
,rrp
=?
,ecost
=?
,budget_id
=?
,orderstatus
='complete'|;
1451 $query .= q
|, order_internalnote
= ?
| if defined $order_internalnote;
1452 $query .= q
|, order_vendornote
= ?
| if defined $order_vendornote;
1453 $query .= q
| where biblionumber
=?
and ordernumber
=?
|;
1454 my $sth = $dbh->prepare( $query );
1462 ( $budget_id ?
$budget_id : $order->{budget_id
} ),
1463 ( defined $order_internalnote ?
$order_internalnote : () ),
1464 ( defined $order_vendornote ?
$order_vendornote : () ),
1469 # All items have been received, sent a notification to users
1470 NotifyOrderUsers
( $ordernumber );
1473 return ($datereceived, $new_ordernumber);
1476 =head3 CancelReceipt
1478 my $parent_ordernumber = CancelReceipt($ordernumber);
1480 Cancel an order line receipt and update the parent order line, as if no
1482 If items are created at receipt (AcqCreateItem = receiving) then delete
1488 my $ordernumber = shift;
1490 return unless $ordernumber;
1492 my $dbh = C4
::Context
->dbh;
1494 SELECT datereceived
, parent_ordernumber
, quantity
1496 WHERE ordernumber
= ?
1498 my $sth = $dbh->prepare($query);
1499 $sth->execute($ordernumber);
1500 my $order = $sth->fetchrow_hashref;
1502 warn "CancelReceipt: order $ordernumber does not exist";
1505 unless($order->{'datereceived'}) {
1506 warn "CancelReceipt: order $ordernumber is not received";
1510 my $parent_ordernumber = $order->{'parent_ordernumber'};
1512 my @itemnumbers = GetItemnumbersFromOrder
( $ordernumber );
1514 if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1515 # The order line has no parent, just mark it as not received
1518 SET quantityreceived
= ?
,
1521 orderstatus
= 'ordered'
1522 WHERE ordernumber
= ?
1524 $sth = $dbh->prepare($query);
1525 $sth->execute(0, undef, undef, $ordernumber);
1526 _cancel_items_receipt
( $ordernumber );
1528 # The order line has a parent, increase parent quantity and delete
1531 SELECT quantity
, datereceived
1533 WHERE ordernumber
= ?
1535 $sth = $dbh->prepare($query);
1536 $sth->execute($parent_ordernumber);
1537 my $parent_order = $sth->fetchrow_hashref;
1538 unless($parent_order) {
1539 warn "Parent order $parent_ordernumber does not exist.";
1542 if($parent_order->{'datereceived'}) {
1543 warn "CancelReceipt: parent order is received.".
1544 " Can't cancel receipt.";
1550 orderstatus
= 'ordered'
1551 WHERE ordernumber
= ?
1553 $sth = $dbh->prepare($query);
1554 my $rv = $sth->execute(
1555 $order->{'quantity'} + $parent_order->{'quantity'},
1559 warn "Cannot update parent order line, so do not cancel".
1563 _cancel_items_receipt
( $ordernumber, $parent_ordernumber );
1566 DELETE FROM aqorders
1567 WHERE ordernumber
= ?
1569 $sth = $dbh->prepare($query);
1570 $sth->execute($ordernumber);
1574 if(C4
::Context
->preference('AcqCreateItem') eq 'ordering') {
1575 my @affects = split q{\|}, C4
::Context
->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1577 for my $in ( @itemnumbers ) {
1578 my $biblionumber = C4
::Biblio
::GetBiblionumberFromItemnumber
( $in );
1579 my $frameworkcode = GetFrameworkCode
($biblionumber);
1580 my ( $itemfield ) = GetMarcFromKohaField
( 'items.itemnumber', $frameworkcode );
1581 my $item = C4
::Items
::GetMarcItem
( $biblionumber, $in );
1582 for my $affect ( @affects ) {
1583 my ( $sf, $v ) = split q{=}, $affect, 2;
1584 foreach ( $item->field($itemfield) ) {
1585 $_->update( $sf => $v );
1588 C4
::Items
::ModItemFromMarc
( $item, $biblionumber, $in );
1593 return $parent_ordernumber;
1596 sub _cancel_items_receipt
{
1597 my ( $ordernumber, $parent_ordernumber ) = @_;
1598 $parent_ordernumber ||= $ordernumber;
1600 my @itemnumbers = GetItemnumbersFromOrder
($ordernumber);
1601 if(C4
::Context
->preference('AcqCreateItem') eq 'receiving') {
1602 # Remove items that were created at receipt
1604 DELETE FROM items
, aqorders_items
1605 USING items
, aqorders_items
1606 WHERE items
.itemnumber
= ? AND aqorders_items
.itemnumber
= ?
1608 my $dbh = C4
::Context
->dbh;
1609 my $sth = $dbh->prepare($query);
1610 foreach my $itemnumber (@itemnumbers) {
1611 $sth->execute($itemnumber, $itemnumber);
1615 foreach my $itemnumber (@itemnumbers) {
1616 ModItemOrder
($itemnumber, $parent_ordernumber);
1621 #------------------------------------------------------------#
1625 @results = &SearchOrders({
1626 ordernumber => $ordernumber,
1628 biblionumber => $biblionumber,
1630 booksellerid => $booksellerid,
1631 basketno => $basketno,
1637 Searches for orders.
1639 C<$owner> Finds order for the logged in user.
1640 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1641 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1644 C<@results> is an array of references-to-hash with the keys are fields
1645 from aqorders, biblio, biblioitems and aqbasket tables.
1650 my ( $params ) = @_;
1651 my $ordernumber = $params->{ordernumber
};
1652 my $search = $params->{search
};
1653 my $ean = $params->{ean
};
1654 my $booksellerid = $params->{booksellerid
};
1655 my $basketno = $params->{basketno
};
1656 my $basketname = $params->{basketname
};
1657 my $basketgroupname = $params->{basketgroupname
};
1658 my $owner = $params->{owner
};
1659 my $pending = $params->{pending
};
1660 my $ordered = $params->{ordered
};
1661 my $biblionumber = $params->{biblionumber
};
1662 my $budget_id = $params->{budget_id
};
1664 my $dbh = C4
::Context
->dbh;
1667 SELECT aqbasket.basketno,
1669 borrowers.firstname,
1672 biblioitems.biblioitemnumber,
1673 aqbasket.authorisedby,
1674 aqbasket.booksellerid,
1676 aqbasket.creationdate,
1677 aqbasket.basketname,
1678 aqbasketgroups.id as basketgroupid,
1679 aqbasketgroups.name as basketgroupname,
1682 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1683 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1684 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1685 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1686 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1689 # If we search on ordernumber, we retrieve the transfered order if a transfer has been done.
1691 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1695 WHERE (datecancellationprinted is NULL)
1698 if ( $pending or $ordered ) {
1699 $query .= q{ AND (quantity > quantityreceived OR quantityreceived is NULL)};
1702 $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1705 my $userenv = C4
::Context
->userenv;
1706 if ( C4
::Context
->preference("IndependentBranches") ) {
1707 unless ( C4
::Context
->IsSuperLibrarian() ) {
1710 borrowers.branchcode = ?
1711 OR borrowers.branchcode = ''
1714 push @args, $userenv->{branch
};
1718 if ( $ordernumber ) {
1719 $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1720 push @args, ( $ordernumber, $ordernumber );
1722 if ( $biblionumber ) {
1723 $query .= 'AND aqorders.biblionumber = ?';
1724 push @args, $biblionumber;
1727 $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1728 push @args, ("%$search%","%$search%","%$search%");
1731 $query .= ' AND biblioitems.ean = ?';
1734 if ( $booksellerid ) {
1735 $query .= 'AND aqbasket.booksellerid = ?';
1736 push @args, $booksellerid;
1739 $query .= 'AND aqbasket.basketno = ?';
1740 push @args, $basketno;
1743 $query .= 'AND aqbasket.basketname LIKE ?';
1744 push @args, "%$basketname%";
1746 if( $basketgroupname ) {
1747 $query .= ' AND aqbasketgroups.name LIKE ?';
1748 push @args, "%$basketgroupname%";
1752 $query .= ' AND aqbasket.authorisedby=? ';
1753 push @args, $userenv->{'number'};
1757 $query .= ' AND aqorders.budget_id = ?';
1758 push @args, $budget_id;
1761 $query .= ' ORDER BY aqbasket.basketno';
1763 my $sth = $dbh->prepare($query);
1764 $sth->execute(@args);
1765 return $sth->fetchall_arrayref({});
1768 #------------------------------------------------------------#
1772 &DelOrder($biblionumber, $ordernumber);
1774 Cancel the order with the given order and biblio numbers. It does not
1775 delete any entries in the aqorders table, it merely marks them as
1781 my ( $bibnum, $ordernumber, $delete_biblio, $reason ) = @_;
1784 my $dbh = C4
::Context
->dbh;
1787 SET datecancellationprinted=now(), orderstatus='cancelled'
1790 $query .= ", cancellationreason = ? ";
1793 WHERE biblionumber=? AND ordernumber=?
1795 my $sth = $dbh->prepare($query);
1797 $sth->execute($reason, $bibnum, $ordernumber);
1799 $sth->execute( $bibnum, $ordernumber );
1803 my @itemnumbers = GetItemnumbersFromOrder
( $ordernumber );
1804 foreach my $itemnumber (@itemnumbers){
1805 my $delcheck = C4
::Items
::DelItemCheck
( $dbh, $bibnum, $itemnumber );
1807 if($delcheck != 1) {
1808 $error->{'delitem'} = 1;
1812 if($delete_biblio) {
1813 # We get the number of remaining items
1814 my $itemcount = C4
::Items
::GetItemsCount
($bibnum);
1816 # If there are no items left,
1817 if ( $itemcount == 0 ) {
1818 # We delete the record
1819 my $delcheck = DelBiblio
($bibnum);
1822 $error->{'delbiblio'} = 1;
1830 =head3 TransferOrder
1832 my $newordernumber = TransferOrder($ordernumber, $basketno);
1834 Transfer an order line to a basket.
1835 Mark $ordernumber as cancelled with an internal note 'Cancelled and transfered
1836 to BOOKSELLER on DATE' and create new order with internal note
1837 'Transfered from BOOKSELLER on DATE'.
1838 Move all attached items to the new order.
1839 Received orders cannot be transfered.
1840 Return the ordernumber of created order.
1845 my ($ordernumber, $basketno) = @_;
1847 return unless ($ordernumber and $basketno);
1849 my $order = GetOrder
( $ordernumber );
1850 return if $order->{datereceived
};
1851 my $basket = GetBasket
($basketno);
1852 return unless $basket;
1854 my $dbh = C4
::Context
->dbh;
1855 my ($query, $sth, $rv);
1859 SET datecancellationprinted = CAST(NOW() AS date)
1860 WHERE ordernumber = ?
1862 $sth = $dbh->prepare($query);
1863 $rv = $sth->execute($ordernumber);
1865 delete $order->{'ordernumber'};
1866 delete $order->{parent_ordernumber
};
1867 $order->{'basketno'} = $basketno;
1869 my $newordernumber = Koha
::Acquisition
::Order
->new($order)->insert->{ordernumber
};
1872 UPDATE aqorders_items
1874 WHERE ordernumber = ?
1876 $sth = $dbh->prepare($query);
1877 $sth->execute($newordernumber, $ordernumber);
1880 INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1883 $sth = $dbh->prepare($query);
1884 $sth->execute($ordernumber, $newordernumber);
1886 return $newordernumber;
1889 =head2 FUNCTIONS ABOUT PARCELS
1893 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1895 get a lists of parcels.
1902 is the bookseller this function has to get parcels.
1905 To know on what criteria the results list has to be ordered.
1908 is the booksellerinvoicenumber.
1910 =item $datefrom & $dateto
1911 to know on what date this function has to filter its search.
1916 a pointer on a hash list containing parcel informations as such :
1922 =item Last operation
1924 =item Number of biblio
1926 =item Number of items
1933 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1934 my $dbh = C4
::Context
->dbh;
1935 my @query_params = ();
1937 SELECT aqinvoices.invoicenumber,
1938 datereceived,purchaseordernumber,
1939 count(DISTINCT biblionumber) AS biblio,
1940 sum(quantity) AS itemsexpected,
1941 sum(quantityreceived) AS itemsreceived
1942 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1943 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1944 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1946 push @query_params, $bookseller;
1948 if ( defined $code ) {
1949 $strsth .= ' and aqinvoices.invoicenumber like ? ';
1950 # add a % to the end of the code to allow stemming.
1951 push @query_params, "$code%";
1954 if ( defined $datefrom ) {
1955 $strsth .= ' and datereceived >= ? ';
1956 push @query_params, $datefrom;
1959 if ( defined $dateto ) {
1960 $strsth .= 'and datereceived <= ? ';
1961 push @query_params, $dateto;
1964 $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
1966 # can't use a placeholder to place this column name.
1967 # but, we could probably be checking to make sure it is a column that will be fetched.
1968 $strsth .= "order by $order " if ($order);
1970 my $sth = $dbh->prepare($strsth);
1972 $sth->execute( @query_params );
1973 my $results = $sth->fetchall_arrayref({});
1977 #------------------------------------------------------------#
1979 =head3 GetLateOrders
1981 @results = &GetLateOrders;
1983 Searches for bookseller with late orders.
1986 the table of supplier with late issues. This table is full of hashref.
1992 my $supplierid = shift;
1994 my $estimateddeliverydatefrom = shift;
1995 my $estimateddeliverydateto = shift;
1997 my $dbh = C4
::Context
->dbh;
1999 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
2000 my $dbdriver = C4
::Context
->config("db_scheme") || "mysql";
2002 my @query_params = ();
2004 SELECT aqbasket.basketno,
2005 aqorders.ordernumber,
2006 DATE(aqbasket.closedate) AS orderdate,
2007 aqbasket.basketname AS basketname,
2008 aqbasket.basketgroupid AS basketgroupid,
2009 aqbasketgroups.name AS basketgroupname,
2010 aqorders.rrp AS unitpricesupplier,
2011 aqorders.ecost AS unitpricelib,
2012 aqorders.claims_count AS claims_count,
2013 aqorders.claimed_date AS claimed_date,
2014 aqbudgets.budget_name AS budget,
2015 borrowers.branchcode AS branch,
2016 aqbooksellers.name AS supplier,
2017 aqbooksellers.id AS supplierid,
2018 biblio.author, biblio.title,
2019 biblioitems.publishercode AS publisher,
2020 biblioitems.publicationyear,
2021 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
2025 aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
2026 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
2027 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
2028 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
2029 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
2030 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2031 WHERE aqorders.basketno = aqbasket.basketno
2032 AND ( datereceived = ''
2033 OR datereceived IS NULL
2034 OR aqorders.quantityreceived < aqorders.quantity
2036 AND aqbasket.closedate IS NOT NULL
2037 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
2040 if ($dbdriver eq "mysql") {
2042 aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity,
2043 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
2044 DATEDIFF(CAST(now() AS date),closedate) AS latesince
2046 if ( defined $delay ) {
2047 $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
2048 push @query_params, $delay;
2051 HAVING quantity <> 0
2052 AND unitpricesupplier <> 0
2053 AND unitpricelib <> 0
2056 # FIXME: account for IFNULL as above
2058 aqorders.quantity AS quantity,
2059 aqorders.quantity * aqorders.rrp AS subtotal,
2060 (CAST(now() AS date) - closedate) AS latesince
2062 if ( defined $delay ) {
2063 $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
2064 push @query_params, $delay;
2067 if (defined $supplierid) {
2068 $from .= ' AND aqbasket.booksellerid = ? ';
2069 push @query_params, $supplierid;
2071 if (defined $branch) {
2072 $from .= ' AND borrowers.branchcode LIKE ? ';
2073 push @query_params, $branch;
2076 if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
2077 $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
2079 if ( defined $estimateddeliverydatefrom ) {
2080 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
2081 push @query_params, $estimateddeliverydatefrom;
2083 if ( defined $estimateddeliverydateto ) {
2084 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
2085 push @query_params, $estimateddeliverydateto;
2087 if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
2088 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
2090 if (C4
::Context
->preference("IndependentBranches")
2091 && !C4
::Context
->IsSuperLibrarian() ) {
2092 $from .= ' AND borrowers.branchcode LIKE ? ';
2093 push @query_params, C4
::Context
->userenv->{branch
};
2095 $from .= " AND orderstatus <> 'cancelled' ";
2096 my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
2097 $debug and print STDERR
"GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
2098 my $sth = $dbh->prepare($query);
2099 $sth->execute(@query_params);
2101 while (my $data = $sth->fetchrow_hashref) {
2102 push @results, $data;
2107 #------------------------------------------------------------#
2111 \@order_loop = GetHistory( %params );
2113 Retreives some acquisition history information
2123 basket - search both basket name and number
2124 booksellerinvoicenumber
2127 orderstatus (note that orderstatus '' will retrieve orders
2128 of any status except cancelled)
2130 get_canceled_order (if set to a true value, cancelled orders will
2134 $order_loop is a list of hashrefs that each look like this:
2136 'author' => 'Twain, Mark',
2138 'biblionumber' => '215',
2140 'creationdate' => 'MM/DD/YYYY',
2141 'datereceived' => undef,
2144 'invoicenumber' => undef,
2146 'ordernumber' => '1',
2148 'quantityreceived' => undef,
2149 'title' => 'The Adventures of Huckleberry Finn'
2155 # don't run the query if there are no parameters (list would be too long for sure !)
2156 croak
"No search params" unless @_;
2158 my $title = $params{title
};
2159 my $author = $params{author
};
2160 my $isbn = $params{isbn
};
2161 my $ean = $params{ean
};
2162 my $name = $params{name
};
2163 my $from_placed_on = $params{from_placed_on
};
2164 my $to_placed_on = $params{to_placed_on
};
2165 my $basket = $params{basket
};
2166 my $booksellerinvoicenumber = $params{booksellerinvoicenumber
};
2167 my $basketgroupname = $params{basketgroupname
};
2168 my $budget = $params{budget
};
2169 my $orderstatus = $params{orderstatus
};
2170 my $biblionumber = $params{biblionumber
};
2171 my $get_canceled_order = $params{get_canceled_order
} || 0;
2172 my $ordernumber = $params{ordernumber
};
2173 my $search_children_too = $params{search_children_too
} || 0;
2174 my $created_by = $params{created_by
} || [];
2178 my $total_qtyreceived = 0;
2179 my $total_price = 0;
2181 my $dbh = C4
::Context
->dbh;
2184 COALESCE(biblio.title, deletedbiblio.title) AS title,
2185 COALESCE(biblio.author, deletedbiblio.author) AS author,
2186 COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2187 COALESCE(biblioitems.ean, deletedbiblioitems.ean) AS ean,
2189 aqbasket.basketname,
2190 aqbasket.basketgroupid,
2191 aqbasket.authorisedby,
2192 concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2193 aqbasketgroups.name as groupname,
2195 aqbasket.creationdate,
2196 aqorders.datereceived,
2198 aqorders.quantityreceived,
2200 aqorders.ordernumber,
2202 aqinvoices.invoicenumber,
2203 aqbooksellers.id as id,
2204 aqorders.biblionumber,
2205 aqorders.orderstatus,
2206 aqorders.parent_ordernumber,
2207 aqbudgets.budget_name
2209 $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2212 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2213 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2214 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2215 LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2216 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2217 LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2218 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2219 LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2220 LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2221 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2224 $query .= " WHERE 1 ";
2226 unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2227 $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2230 my @query_params = ();
2232 if ( $biblionumber ) {
2233 $query .= " AND biblio.biblionumber = ?";
2234 push @query_params, $biblionumber;
2238 $query .= " AND biblio.title LIKE ? ";
2239 $title =~ s/\s+/%/g;
2240 push @query_params, "%$title%";
2244 $query .= " AND biblio.author LIKE ? ";
2245 push @query_params, "%$author%";
2249 $query .= " AND biblioitems.isbn LIKE ? ";
2250 push @query_params, "%$isbn%";
2253 $query .= " AND biblioitems.ean = ? ";
2254 push @query_params, "$ean";
2257 $query .= " AND aqbooksellers.name LIKE ? ";
2258 push @query_params, "%$name%";
2262 $query .= " AND aqbudgets.budget_id = ? ";
2263 push @query_params, "$budget";
2266 if ( $from_placed_on ) {
2267 $query .= " AND creationdate >= ? ";
2268 push @query_params, $from_placed_on;
2271 if ( $to_placed_on ) {
2272 $query .= " AND creationdate <= ? ";
2273 push @query_params, $to_placed_on;
2276 if ( defined $orderstatus and $orderstatus ne '') {
2277 $query .= " AND aqorders.orderstatus = ? ";
2278 push @query_params, "$orderstatus";
2282 if ($basket =~ m/^\d+$/) {
2283 $query .= " AND aqorders.basketno = ? ";
2284 push @query_params, $basket;
2286 $query .= " AND aqbasket.basketname LIKE ? ";
2287 push @query_params, "%$basket%";
2291 if ($booksellerinvoicenumber) {
2292 $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2293 push @query_params, "%$booksellerinvoicenumber%";
2296 if ($basketgroupname) {
2297 $query .= " AND aqbasketgroups.name LIKE ? ";
2298 push @query_params, "%$basketgroupname%";
2302 $query .= " AND (aqorders.ordernumber = ? ";
2303 push @query_params, $ordernumber;
2304 if ($search_children_too) {
2305 $query .= " OR aqorders.parent_ordernumber = ? ";
2306 push @query_params, $ordernumber;
2311 if ( @
$created_by ) {
2312 $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @
$created_by ) . ')';
2313 push @query_params, @
$created_by;
2317 if ( C4
::Context
->preference("IndependentBranches") ) {
2318 unless ( C4
::Context
->IsSuperLibrarian() ) {
2319 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2320 push @query_params, C4
::Context
->userenv->{branch
};
2323 $query .= " ORDER BY id";
2325 return $dbh->selectall_arrayref( $query, { Slice
=> {} }, @query_params );
2328 =head2 GetRecentAcqui
2330 $results = GetRecentAcqui($days);
2332 C<$results> is a ref to a table which containts hashref
2336 sub GetRecentAcqui
{
2338 my $dbh = C4
::Context
->dbh;
2342 ORDER BY timestamp DESC
2345 my $sth = $dbh->prepare($query);
2347 my $results = $sth->fetchall_arrayref({});
2351 #------------------------------------------------------------#
2355 &AddClaim($ordernumber);
2357 Add a claim for an order
2362 my ($ordernumber) = @_;
2363 my $dbh = C4
::Context
->dbh;
2366 claims_count = claims_count + 1,
2367 claimed_date = CURDATE()
2368 WHERE ordernumber = ?
2370 my $sth = $dbh->prepare($query);
2371 $sth->execute($ordernumber);
2376 my @invoices = GetInvoices(
2377 invoicenumber => $invoicenumber,
2378 supplierid => $supplierid,
2379 suppliername => $suppliername,
2380 shipmentdatefrom => $shipmentdatefrom, # ISO format
2381 shipmentdateto => $shipmentdateto, # ISO format
2382 billingdatefrom => $billingdatefrom, # ISO format
2383 billingdateto => $billingdateto, # ISO format
2384 isbneanissn => $isbn_or_ean_or_issn,
2387 publisher => $publisher,
2388 publicationyear => $publicationyear,
2389 branchcode => $branchcode,
2390 order_by => $order_by
2393 Return a list of invoices that match all given criteria.
2395 $order_by is "column_name (asc|desc)", where column_name is any of
2396 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2397 'shipmentcost', 'shipmentcost_budgetid'.
2399 asc is the default if omitted
2406 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2407 closedate shipmentcost shipmentcost_budgetid);
2409 my $dbh = C4
::Context
->dbh;
2411 SELECT aqinvoices
.*, aqbooksellers
.name AS suppliername
,
2414 aqorders
.datereceived IS NOT NULL
,
2415 aqorders
.biblionumber
,
2418 ) AS receivedbiblios
,
2421 aqorders
.subscriptionid IS NOT NULL
,
2422 aqorders
.subscriptionid
,
2425 ) AS is_linked_to_subscriptions
,
2426 SUM
(aqorders
.quantityreceived
) AS receiveditems
2428 LEFT JOIN aqbooksellers ON aqbooksellers
.id
= aqinvoices
.booksellerid
2429 LEFT JOIN aqorders ON aqorders
.invoiceid
= aqinvoices
.invoiceid
2430 LEFT JOIN aqbasket ON aqbasket
.basketno
=aqorders
.basketno
2431 LEFT JOIN borrowers ON aqbasket
.authorisedby
=borrowers
.borrowernumber
2432 LEFT JOIN biblio ON aqorders
.biblionumber
= biblio
.biblionumber
2433 LEFT JOIN biblioitems ON biblio
.biblionumber
= biblioitems
.biblionumber
2434 LEFT JOIN subscription ON biblio
.biblionumber
= subscription
.biblionumber
2439 if($args{supplierid
}) {
2440 push @bind_strs, " aqinvoices.booksellerid = ? ";
2441 push @bind_args, $args{supplierid
};
2443 if($args{invoicenumber
}) {
2444 push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2445 push @bind_args, "%$args{invoicenumber}%";
2447 if($args{suppliername
}) {
2448 push @bind_strs, " aqbooksellers.name LIKE ? ";
2449 push @bind_args, "%$args{suppliername}%";
2451 if($args{shipmentdatefrom
}) {
2452 push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2453 push @bind_args, $args{shipmentdatefrom
};
2455 if($args{shipmentdateto
}) {
2456 push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2457 push @bind_args, $args{shipmentdateto
};
2459 if($args{billingdatefrom
}) {
2460 push @bind_strs, " aqinvoices.billingdate >= ? ";
2461 push @bind_args, $args{billingdatefrom
};
2463 if($args{billingdateto
}) {
2464 push @bind_strs, " aqinvoices.billingdate <= ? ";
2465 push @bind_args, $args{billingdateto
};
2467 if($args{isbneanissn
}) {
2468 push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2469 push @bind_args, $args{isbneanissn
}, $args{isbneanissn
}, $args{isbneanissn
};
2472 push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2473 push @bind_args, $args{title
};
2476 push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2477 push @bind_args, $args{author
};
2479 if($args{publisher
}) {
2480 push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2481 push @bind_args, $args{publisher
};
2483 if($args{publicationyear
}) {
2484 push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2485 push @bind_args, $args{publicationyear
}, $args{publicationyear
};
2487 if($args{branchcode
}) {
2488 push @bind_strs, " borrowers.branchcode = ? ";
2489 push @bind_args, $args{branchcode
};
2492 $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2493 $query .= " GROUP BY aqinvoices.invoiceid ";
2495 if($args{order_by
}) {
2496 my ($column, $direction) = split / /, $args{order_by
};
2497 if(grep /^$column$/, @columns) {
2498 $direction ||= 'ASC';
2499 $query .= " ORDER BY $column $direction";
2503 my $sth = $dbh->prepare($query);
2504 $sth->execute(@bind_args);
2506 my $results = $sth->fetchall_arrayref({});
2512 my $invoice = GetInvoice($invoiceid);
2514 Get informations about invoice with given $invoiceid
2516 Return a hash filled with aqinvoices.* fields
2521 my ($invoiceid) = @_;
2524 return unless $invoiceid;
2526 my $dbh = C4
::Context
->dbh;
2532 my $sth = $dbh->prepare($query);
2533 $sth->execute($invoiceid);
2535 $invoice = $sth->fetchrow_hashref;
2539 =head3 GetInvoiceDetails
2541 my $invoice = GetInvoiceDetails($invoiceid)
2543 Return informations about an invoice + the list of related order lines
2545 Orders informations are in $invoice->{orders} (array ref)
2549 sub GetInvoiceDetails
{
2550 my ($invoiceid) = @_;
2552 if ( !defined $invoiceid ) {
2553 carp
'GetInvoiceDetails called without an invoiceid';
2557 my $dbh = C4
::Context
->dbh;
2559 SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2561 LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2564 my $sth = $dbh->prepare($query);
2565 $sth->execute($invoiceid);
2567 my $invoice = $sth->fetchrow_hashref;
2572 biblio.copyrightdate,
2573 biblioitems.publishercode,
2574 biblioitems.publicationyear,
2575 aqbasket.basketname,
2576 aqbasketgroups.id AS basketgroupid,
2577 aqbasketgroups.name AS basketgroupname
2579 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2580 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2581 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2582 LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2585 $sth = $dbh->prepare($query);
2586 $sth->execute($invoiceid);
2587 $invoice->{orders
} = $sth->fetchall_arrayref({});
2588 $invoice->{orders
} ||= []; # force an empty arrayref if fetchall_arrayref fails
2595 my $invoiceid = AddInvoice(
2596 invoicenumber => $invoicenumber,
2597 booksellerid => $booksellerid,
2598 shipmentdate => $shipmentdate,
2599 billingdate => $billingdate,
2600 closedate => $closedate,
2601 shipmentcost => $shipmentcost,
2602 shipmentcost_budgetid => $shipmentcost_budgetid
2605 Create a new invoice and return its id or undef if it fails.
2612 return unless(%invoice and $invoice{invoicenumber
});
2614 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2615 closedate shipmentcost shipmentcost_budgetid);
2619 foreach my $key (keys %invoice) {
2620 if(0 < grep(/^$key$/, @columns)) {
2621 push @set_strs, "$key = ?";
2622 push @set_args, ($invoice{$key} || undef);
2628 my $dbh = C4
::Context
->dbh;
2629 my $query = "INSERT INTO aqinvoices SET ";
2630 $query .= join (",", @set_strs);
2631 my $sth = $dbh->prepare($query);
2632 $rv = $sth->execute(@set_args);
2634 $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2643 invoiceid => $invoiceid, # Mandatory
2644 invoicenumber => $invoicenumber,
2645 booksellerid => $booksellerid,
2646 shipmentdate => $shipmentdate,
2647 billingdate => $billingdate,
2648 closedate => $closedate,
2649 shipmentcost => $shipmentcost,
2650 shipmentcost_budgetid => $shipmentcost_budgetid
2653 Modify an invoice, invoiceid is mandatory.
2655 Return undef if it fails.
2662 return unless(%invoice and $invoice{invoiceid
});
2664 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2665 closedate shipmentcost shipmentcost_budgetid);
2669 foreach my $key (keys %invoice) {
2670 if(0 < grep(/^$key$/, @columns)) {
2671 push @set_strs, "$key = ?";
2672 push @set_args, ($invoice{$key} || undef);
2676 my $dbh = C4
::Context
->dbh;
2677 my $query = "UPDATE aqinvoices SET ";
2678 $query .= join(",", @set_strs);
2679 $query .= " WHERE invoiceid = ?";
2681 my $sth = $dbh->prepare($query);
2682 $sth->execute(@set_args, $invoice{invoiceid
});
2687 CloseInvoice($invoiceid);
2691 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2696 my ($invoiceid) = @_;
2698 return unless $invoiceid;
2700 my $dbh = C4
::Context
->dbh;
2703 SET closedate
= CAST
(NOW
() AS DATE
)
2706 my $sth = $dbh->prepare($query);
2707 $sth->execute($invoiceid);
2710 =head3 ReopenInvoice
2712 ReopenInvoice($invoiceid);
2716 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => C4::Dates->new()->output('iso'))
2721 my ($invoiceid) = @_;
2723 return unless $invoiceid;
2725 my $dbh = C4
::Context
->dbh;
2728 SET closedate
= NULL
2731 my $sth = $dbh->prepare($query);
2732 $sth->execute($invoiceid);
2737 DelInvoice($invoiceid);
2739 Delete an invoice if there are no items attached to it.
2744 my ($invoiceid) = @_;
2746 return unless $invoiceid;
2748 my $dbh = C4
::Context
->dbh;
2754 my $sth = $dbh->prepare($query);
2755 $sth->execute($invoiceid);
2756 my $res = $sth->fetchrow_arrayref;
2757 if ( $res && $res->[0] == 0 ) {
2759 DELETE FROM aqinvoices
2762 my $sth = $dbh->prepare($query);
2763 return ( $sth->execute($invoiceid) > 0 );
2768 =head3 MergeInvoices
2770 MergeInvoices($invoiceid, \@sourceids);
2772 Merge the invoices identified by the IDs in \@sourceids into
2773 the invoice identified by $invoiceid.
2778 my ($invoiceid, $sourceids) = @_;
2780 return unless $invoiceid;
2781 foreach my $sourceid (@
$sourceids) {
2782 next if $sourceid == $invoiceid;
2783 my $source = GetInvoiceDetails
($sourceid);
2784 foreach my $order (@
{$source->{'orders'}}) {
2785 $order->{'invoiceid'} = $invoiceid;
2788 DelInvoice
($source->{'invoiceid'});
2793 =head3 GetBiblioCountByBasketno
2795 $biblio_count = &GetBiblioCountByBasketno($basketno);
2797 Looks up the biblio's count that has basketno value $basketno
2803 sub GetBiblioCountByBasketno
{
2804 my ($basketno) = @_;
2805 my $dbh = C4
::Context
->dbh;
2807 SELECT COUNT( DISTINCT( biblionumber ) )
2810 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
2813 my $sth = $dbh->prepare($query);
2814 $sth->execute($basketno);
2815 return $sth->fetchrow;
2818 # This is *not* the good way to calcul prices
2819 # But it's how it works at the moment into Koha
2820 # This will be fixed later.
2821 # Note this subroutine should be moved to Koha::Acquisition::Order
2822 # Will do when a DBIC decision will be taken.
2823 sub populate_order_with_prices
{
2826 my $order = $params->{order
};
2827 my $booksellerid = $params->{booksellerid
};
2828 return unless $booksellerid;
2830 my $bookseller = Koha
::Acquisition
::Bookseller
->fetch({ id
=> $booksellerid });
2832 my $receiving = $params->{receiving
};
2833 my $ordering = $params->{ordering
};
2834 my $discount = $order->{discount
};
2835 $discount /= 100 if $discount > 1;
2837 $order->{rrp
} = Koha
::Number
::Price
->new( $order->{rrp
} )->round;
2838 $order->{ecost
} = Koha
::Number
::Price
->new( $order->{ecost
} )->round;
2840 if ( $bookseller->{listincgst
} ) {
2841 $order->{rrpgsti
} = $order->{rrp
};
2842 $order->{rrpgste
} = Koha
::Number
::Price
->new(
2843 $order->{rrpgsti
} / ( 1 + $order->{gstrate
} ) )->round;
2844 $order->{ecostgsti
} = $order->{ecost
};
2845 $order->{ecostgste
} = Koha
::Number
::Price
->new(
2846 $order->{ecost
} / ( 1 + $order->{gstrate
} ) )->round;
2847 $order->{gstvalue
} = Koha
::Number
::Price
->new(
2848 ( $order->{ecostgsti
} - $order->{ecostgste
} ) *
2849 $order->{quantity
} )->round;
2850 $order->{totalgste
} = $order->{ecostgste
} * $order->{quantity
};
2851 $order->{totalgsti
} = $order->{ecostgsti
} * $order->{quantity
};
2854 $order->{rrpgste
} = $order->{rrp
};
2855 $order->{rrpgsti
} = Koha
::Number
::Price
->new(
2856 $order->{rrp
} * ( 1 + $order->{gstrate
} ) )->round;
2857 $order->{ecostgste
} = $order->{ecost
};
2858 $order->{ecostgsti
} = Koha
::Number
::Price
->new(
2859 $order->{ecost
} * ( 1 + $order->{gstrate
} ) )->round;
2860 $order->{gstvalue
} = Koha
::Number
::Price
->new(
2861 ( $order->{ecostgsti
} - $order->{ecostgste
} ) *
2862 $order->{quantity
} )->round;
2863 $order->{totalgste
} = $order->{ecostgste
} * $order->{quantity
};
2864 $order->{totalgsti
} = $order->{ecostgsti
} * $order->{quantity
};
2869 if ( $bookseller->{listincgst
} ) {
2870 $order->{unitpricegsti
} = Koha
::Number
::Price
->new( $order->{unitprice
} )->round;
2871 $order->{unitpricegste
} = Koha
::Number
::Price
->new(
2872 $order->{unitpricegsti
} / ( 1 + $order->{gstrate
} ) )->round;
2875 $order->{unitpricegste
} = Koha
::Number
::Price
->new( $order->{unitprice
} )->round;
2876 $order->{unitpricegsti
} = Koha
::Number
::Price
->new(
2877 $order->{unitpricegste
} * ( 1 + $order->{gstrate
} ) )->round;
2879 $order->{gstvalue
} = Koha
::Number
::Price
->new(
2880 ( $order->{unitpricegsti
} - $order->{unitpricegste
} )
2881 * $order->{quantityreceived
} )->round;
2883 $order->{totalgste
} = $order->{unitpricegste
} * $order->{quantity
};
2884 $order->{totalgsti
} = $order->{unitpricegsti
} * $order->{quantity
};
2890 =head3 GetOrderUsers
2892 $order_users_ids = &GetOrderUsers($ordernumber);
2894 Returns a list of all borrowernumbers that are in order users list
2899 my ($ordernumber) = @_;
2901 return unless $ordernumber;
2904 SELECT borrowernumber
2906 WHERE ordernumber
= ?
2908 my $dbh = C4
::Context
->dbh;
2909 my $sth = $dbh->prepare($query);
2910 $sth->execute($ordernumber);
2911 my $results = $sth->fetchall_arrayref( {} );
2913 my @borrowernumbers;
2914 foreach (@
$results) {
2915 push @borrowernumbers, $_->{'borrowernumber'};
2918 return @borrowernumbers;
2921 =head3 ModOrderUsers
2923 my @order_users_ids = (1, 2, 3);
2924 &ModOrderUsers($ordernumber, @basketusers_ids);
2926 Delete all users from order users list, and add users in C<@order_users_ids>
2932 my ( $ordernumber, @order_users_ids ) = @_;
2934 return unless $ordernumber;
2936 my $dbh = C4
::Context
->dbh;
2938 DELETE FROM aqorder_users
2939 WHERE ordernumber
= ?
2941 my $sth = $dbh->prepare($query);
2942 $sth->execute($ordernumber);
2945 INSERT INTO aqorder_users
(ordernumber
, borrowernumber
)
2948 $sth = $dbh->prepare($query);
2949 foreach my $order_user_id (@order_users_ids) {
2950 $sth->execute( $ordernumber, $order_user_id );
2954 sub NotifyOrderUsers
{
2955 my ($ordernumber) = @_;
2957 my @borrowernumbers = GetOrderUsers
($ordernumber);
2958 return unless @borrowernumbers;
2960 my $order = GetOrder
( $ordernumber );
2961 for my $borrowernumber (@borrowernumbers) {
2962 my $borrower = C4
::Members
::GetMember
( borrowernumber
=> $borrowernumber );
2963 my $branch = C4
::Branch
::GetBranchDetail
( $borrower->{branchcode
} );
2964 my $biblio = C4
::Biblio
::GetBiblio
( $order->{biblionumber
} );
2965 my $letter = C4
::Letters
::GetPreparedLetter
(
2966 module
=> 'acquisition',
2967 letter_code
=> 'ACQ_NOTIF_ON_RECEIV',
2968 branchcode
=> $branch->{branchcode
},
2970 'branches' => $branch,
2971 'borrowers' => $borrower,
2972 'biblio' => $biblio,
2973 'aqorders' => $order,
2977 C4
::Letters
::EnqueueLetter
(
2980 borrowernumber
=> $borrowernumber,
2981 LibraryName
=> C4
::Context
->preference("LibraryName"),
2982 message_transport_type
=> 'email',
2984 ) or warn "can't enqueue letter $letter";
2994 Koha Development Team <http://koha-community.org/>