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::Booksellers;
32 use Koha::Acquisition::Orders;
36 use Koha::Number::Price;
38 use Koha::CsvProfiles;
48 use vars qw(@ISA @EXPORT);
54 &GetBasket &NewBasket &CloseBasket &ReopenBasket &DelBasket &ModBasket
55 &GetBasketAsCSV &GetBasketGroupAsCSV
56 &GetBasketsByBookseller &GetBasketsByBasketgroup
57 &GetBasketsInfosByBookseller
59 &GetBasketUsers &ModBasketUsers
64 &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup
65 &GetBasketgroups &ReOpenBasketgroup
67 &DelOrder &ModOrder &GetOrder &GetOrders &GetOrdersByBiblionumber
68 &GetLateOrders &GetOrderFromItemnumber
69 &SearchOrders &GetHistory &GetRecentAcqui
70 &ModReceiveOrder &CancelReceipt
72 &GetLastOrderNotReceivedFromSubscriptionid &GetLastOrderReceivedFromSubscriptionid
87 &GetItemnumbersFromOrder
90 &GetBiblioCountByBasketno
96 &FillWithDefaultValues
104 sub GetOrderFromItemnumber {
105 my ($itemnumber) = @_;
106 my $dbh = C4::Context->dbh;
109 SELECT * from aqorders LEFT JOIN aqorders_items
110 ON ( aqorders.ordernumber = aqorders_items.ordernumber )
111 WHERE itemnumber = ? |;
113 my $sth = $dbh->prepare($query);
117 $sth->execute($itemnumber);
119 my $order = $sth->fetchrow_hashref;
124 # Returns the itemnumber(s) associated with the ordernumber given in parameter
125 sub GetItemnumbersFromOrder {
126 my ($ordernumber) = @_;
127 my $dbh = C4::Context->dbh;
128 my $query = "SELECT itemnumber FROM aqorders_items WHERE ordernumber=?";
129 my $sth = $dbh->prepare($query);
130 $sth->execute($ordernumber);
133 while (my $order = $sth->fetchrow_hashref) {
134 push @tab, $order->{'itemnumber'};
148 C4::Acquisition - Koha functions for dealing with orders and acquisitions
156 The functions in this module deal with acquisitions, managing book
157 orders, basket and parcels.
161 =head2 FUNCTIONS ABOUT BASKETS
165 $aqbasket = &GetBasket($basketnumber);
167 get all basket informations in aqbasket for a given basket
169 B<returns:> informations for a given basket returned as a hashref.
175 my $dbh = C4::Context->dbh;
178 concat( b.firstname,' ',b.surname) AS authorisedbyname
180 LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
183 my $sth=$dbh->prepare($query);
184 $sth->execute($basketno);
185 my $basket = $sth->fetchrow_hashref;
189 #------------------------------------------------------------#
193 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
194 $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace, $is_standing, $create_items );
196 Create a new basket in aqbasket table
200 =item C<$booksellerid> is a foreign key in the aqbasket table
202 =item C<$authorizedby> is the username of who created the basket
206 The other parameters are optional, see ModBasketHeader for more info on them.
211 my ( $booksellerid, $authorisedby, $basketname, $basketnote,
212 $basketbooksellernote, $basketcontractnumber, $deliveryplace,
213 $billingplace, $is_standing, $create_items ) = @_;
214 my $dbh = C4::Context->dbh;
216 'INSERT INTO aqbasket (creationdate,booksellerid,authorisedby) '
217 . 'VALUES (now(),?,?)';
218 $dbh->do( $query, {}, $booksellerid, $authorisedby );
220 my $basket = $dbh->{mysql_insertid};
221 $basketname ||= q{}; # default to empty strings
223 $basketbooksellernote ||= q{};
224 ModBasketHeader( $basket, $basketname, $basketnote, $basketbooksellernote,
225 $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items );
229 #------------------------------------------------------------#
233 &CloseBasket($basketno);
235 close a basket (becomes unmodifiable, except for receives)
241 my $dbh = C4::Context->dbh;
242 $dbh->do('UPDATE aqbasket SET closedate=now() WHERE basketno=?', {}, $basketno );
245 q{UPDATE aqorders SET orderstatus = 'ordered' WHERE basketno = ? AND orderstatus NOT IN ( 'complete', 'cancelled')},
253 &ReopenBasket($basketno);
261 my $dbh = C4::Context->dbh;
262 $dbh->do( q{UPDATE aqbasket SET closedate=NULL WHERE basketno=?}, {}, $basketno );
266 SET orderstatus = 'new'
268 AND orderstatus NOT IN ( 'complete', 'cancelled' )
273 #------------------------------------------------------------#
275 =head3 GetBasketAsCSV
277 &GetBasketAsCSV($basketno);
279 Export a basket as CSV
281 $cgi parameter is needed for column name translation
286 my ($basketno, $cgi, $csv_profile_id) = @_;
287 my $basket = GetBasket($basketno);
288 my @orders = GetOrders($basketno);
289 my $contract = GetContract({
290 contractnumber => $basket->{'contractnumber'}
293 my $template = C4::Templates::gettemplate("acqui/csv/basket.tt", "intranet", $cgi);
295 if ($csv_profile_id) {
296 my $csv_profile = Koha::CsvProfiles->find( $csv_profile_id );
297 Koha::Exceptions::ObjectNotFound->throw( 'There is no valid csv profile given') unless $csv_profile;
299 my $csv = Text::CSV_XS->new({'quote_char'=>'"','escape_char'=>'"','sep_char'=>$csv_profile->csv_separator,'binary'=>1});
300 my $csv_profile_content = $csv_profile->content;
301 my ( @headers, @fields );
302 while ( $csv_profile_content =~ /
305 ([^\|]*) # fieldname (table.row or row)
309 my $field = ($2 eq '') ? $1 : $2;
311 $header =~ s/^\s+|\s+$//g; # Trim whitespaces
312 push @headers, $header;
314 $field =~ s/[^\.]*\.{1}//; # Remove the table name if exists.
315 $field =~ s/^\s+|\s+$//g; # Trim whitespaces
316 push @fields, $field;
318 for my $order (@orders) {
320 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
321 my $biblioitem = $biblio->biblioitem;
322 $order = { %$order, %{ $biblioitem->unblessed } };
324 $order = {%$order, %$contract};
326 $order = {%$order, %$basket, %{ $biblio->unblessed }};
327 for my $field (@fields) {
328 push @row, $order->{$field};
332 my $content = join( $csv_profile->csv_separator, @headers ) . "\n";
333 for my $row ( @rows ) {
334 $csv->combine(@$row);
335 my $string = $csv->string;
336 $content .= $string . "\n";
341 foreach my $order (@orders) {
342 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
343 my $biblioitem = $biblio->biblioitem;
345 contractname => $contract->{'contractname'},
346 ordernumber => $order->{'ordernumber'},
347 entrydate => $order->{'entrydate'},
348 isbn => $order->{'isbn'},
349 author => $biblio->author,
350 title => $biblio->title,
351 publicationyear => $biblioitem->publicationyear,
352 publishercode => $biblioitem->publishercode,
353 collectiontitle => $biblioitem->collectiontitle,
354 notes => $order->{'order_vendornote'},
355 quantity => $order->{'quantity'},
356 rrp => $order->{'rrp'},
358 for my $place ( qw( deliveryplace billingplace ) ) {
359 if ( my $library = Koha::Libraries->find( $row->{deliveryplace} ) ) {
360 $row->{$place} = $library->branchname
364 contractname author title publishercode collectiontitle notes
365 deliveryplace billingplace
367 # Double the quotes to not be interpreted as a field end
368 $row->{$_} =~ s/"/""/g if $row->{$_};
374 if(defined $a->{publishercode} and defined $b->{publishercode}) {
375 $a->{publishercode} cmp $b->{publishercode};
379 $template->param(rows => \@rows);
381 return $template->output;
386 =head3 GetBasketGroupAsCSV
388 &GetBasketGroupAsCSV($basketgroupid);
390 Export a basket group as CSV
392 $cgi parameter is needed for column name translation
396 sub GetBasketGroupAsCSV {
397 my ($basketgroupid, $cgi) = @_;
398 my $baskets = GetBasketsByBasketgroup($basketgroupid);
400 my $template = C4::Templates::gettemplate('acqui/csv/basketgroup.tt', 'intranet', $cgi);
403 for my $basket (@$baskets) {
404 my @orders = GetOrders( $basket->{basketno} );
405 my $contract = GetContract({
406 contractnumber => $basket->{contractnumber}
408 my $bookseller = Koha::Acquisition::Booksellers->find( $basket->{booksellerid} );
409 my $basketgroup = GetBasketgroup( $$basket{basketgroupid} );
411 foreach my $order (@orders) {
412 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
413 my $biblioitem = $biblio->biblioitem;
415 clientnumber => $bookseller->accountnumber,
416 basketname => $basket->{basketname},
417 ordernumber => $order->{ordernumber},
418 author => $biblio->author,
419 title => $biblio->title,
420 publishercode => $biblioitem->publishercode,
421 publicationyear => $biblioitem->publicationyear,
422 collectiontitle => $biblioitem->collectiontitle,
423 isbn => $order->{isbn},
424 quantity => $order->{quantity},
425 rrp_tax_included => $order->{rrp_tax_included},
426 rrp_tax_excluded => $order->{rrp_tax_excluded},
427 discount => $bookseller->discount,
428 ecost_tax_included => $order->{ecost_tax_included},
429 ecost_tax_excluded => $order->{ecost_tax_excluded},
430 notes => $order->{order_vendornote},
431 entrydate => $order->{entrydate},
432 booksellername => $bookseller->name,
433 bookselleraddress => $bookseller->address1,
434 booksellerpostal => $bookseller->postal,
435 contractnumber => $contract->{contractnumber},
436 contractname => $contract->{contractname},
439 basketgroupdeliveryplace => $basketgroup->{deliveryplace},
440 basketgroupbillingplace => $basketgroup->{billingplace},
441 basketdeliveryplace => $basket->{deliveryplace},
442 basketbillingplace => $basket->{billingplace},
444 for my $place (qw( basketgroupdeliveryplace basketgroupbillingplace basketdeliveryplace basketbillingplace )) {
445 if ( my $library = Koha::Libraries->find( $temp->{$place} ) ) {
446 $row->{$place} = $library->branchname;
450 basketname author title publishercode collectiontitle notes
451 booksellername bookselleraddress booksellerpostal contractname
452 basketgroupdeliveryplace basketgroupbillingplace
453 basketdeliveryplace basketbillingplace
455 # Double the quotes to not be interpreted as a field end
456 $row->{$_} =~ s/"/""/g if $row->{$_};
461 $template->param(rows => \@rows);
463 return $template->output;
467 =head3 CloseBasketgroup
469 &CloseBasketgroup($basketgroupno);
475 sub CloseBasketgroup {
476 my ($basketgroupno) = @_;
477 my $dbh = C4::Context->dbh;
478 my $sth = $dbh->prepare("
479 UPDATE aqbasketgroups
483 $sth->execute($basketgroupno);
486 #------------------------------------------------------------#
488 =head3 ReOpenBaskergroup($basketgroupno)
490 &ReOpenBaskergroup($basketgroupno);
496 sub ReOpenBasketgroup {
497 my ($basketgroupno) = @_;
498 my $dbh = C4::Context->dbh;
499 my $sth = $dbh->prepare("
500 UPDATE aqbasketgroups
504 $sth->execute($basketgroupno);
507 #------------------------------------------------------------#
512 &DelBasket($basketno);
514 Deletes the basket that has basketno field $basketno in the aqbasket table.
518 =item C<$basketno> is the primary key of the basket in the aqbasket table.
525 my ( $basketno ) = @_;
526 my $query = "DELETE FROM aqbasket WHERE basketno=?";
527 my $dbh = C4::Context->dbh;
528 my $sth = $dbh->prepare($query);
529 $sth->execute($basketno);
533 #------------------------------------------------------------#
537 &ModBasket($basketinfo);
539 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
543 =item C<$basketno> is the primary key of the basket in the aqbasket table.
550 my $basketinfo = shift;
551 my $query = "UPDATE aqbasket SET ";
553 foreach my $key (keys %$basketinfo){
554 if ($key ne 'basketno'){
555 $query .= "$key=?, ";
556 push(@params, $basketinfo->{$key} || undef );
559 # get rid of the "," at the end of $query
560 if (substr($query, length($query)-2) eq ', '){
565 $query .= "WHERE basketno=?";
566 push(@params, $basketinfo->{'basketno'});
567 my $dbh = C4::Context->dbh;
568 my $sth = $dbh->prepare($query);
569 $sth->execute(@params);
574 #------------------------------------------------------------#
576 =head3 ModBasketHeader
578 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
580 Modifies a basket's header.
584 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
586 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
588 =item C<$note> is the "note" field in the "aqbasket" table;
590 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
592 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
594 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
596 =item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
598 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
600 =item C<$is_standing> is the "is_standing" field in the aqbasket table.
602 =item C<$create_items> should be set to 'ordering', 'receiving' or 'cataloguing' (or undef, in which
603 case the AcqCreateItem syspref takes precedence).
609 sub ModBasketHeader {
610 my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items) = @_;
615 SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=?, is_standing=?, create_items=?
619 my $dbh = C4::Context->dbh;
620 my $sth = $dbh->prepare($query);
621 $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items || undef, $basketno);
623 if ( $contractnumber ) {
624 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
625 my $sth2 = $dbh->prepare($query2);
626 $sth2->execute($contractnumber,$basketno);
631 #------------------------------------------------------------#
633 =head3 GetBasketsByBookseller
635 @results = &GetBasketsByBookseller($booksellerid, $extra);
637 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
641 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
643 =item C<$extra> is the extra sql parameters, can be
645 $extra->{groupby}: group baskets by column
646 ex. $extra->{groupby} = aqbasket.basketgroupid
647 $extra->{orderby}: order baskets by column
648 $extra->{limit}: limit number of results (can be helpful for pagination)
654 sub GetBasketsByBookseller {
655 my ($booksellerid, $extra) = @_;
656 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
658 if ($extra->{groupby}) {
659 $query .= " GROUP by $extra->{groupby}";
661 if ($extra->{orderby}){
662 $query .= " ORDER by $extra->{orderby}";
664 if ($extra->{limit}){
665 $query .= " LIMIT $extra->{limit}";
668 my $dbh = C4::Context->dbh;
669 my $sth = $dbh->prepare($query);
670 $sth->execute($booksellerid);
671 return $sth->fetchall_arrayref({});
674 =head3 GetBasketsInfosByBookseller
676 my $baskets = GetBasketsInfosByBookseller($supplierid, $allbaskets);
678 The optional second parameter allbaskets is a boolean allowing you to
679 select all baskets from the supplier; by default only active baskets (open or
680 closed but still something to receive) are returned.
682 Returns in a arrayref of hashref all about booksellers baskets, plus:
683 total_biblios: Number of distinct biblios in basket
684 total_items: Number of items in basket
685 expected_items: Number of non-received items in basket
689 sub GetBasketsInfosByBookseller {
690 my ($supplierid, $allbaskets) = @_;
692 return unless $supplierid;
694 my $dbh = C4::Context->dbh;
696 SELECT aqbasket.basketno, aqbasket.basketname, aqbasket.note, aqbasket.booksellernote, aqbasket.contractnumber, aqbasket.creationdate, aqbasket.closedate, aqbasket.booksellerid, aqbasket.authorisedby, aqbasket.booksellerinvoicenumber, aqbasket.basketgroupid, aqbasket.deliveryplace, aqbasket.billingplace, aqbasket.branch, aqbasket.is_standing, aqbasket.create_items,
697 SUM(aqorders.quantity) AS total_items,
699 IF ( aqorders.orderstatus = 'cancelled', aqorders.quantity, 0 )
700 ) AS total_items_cancelled,
701 COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
703 IF(aqorders.datereceived IS NULL
704 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
709 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
710 WHERE booksellerid = ?};
712 $query.=" GROUP BY aqbasket.basketno, aqbasket.basketname, aqbasket.note, aqbasket.booksellernote, aqbasket.contractnumber, aqbasket.creationdate, aqbasket.closedate, aqbasket.booksellerid, aqbasket.authorisedby, aqbasket.booksellerinvoicenumber, aqbasket.basketgroupid, aqbasket.deliveryplace, aqbasket.billingplace, aqbasket.branch, aqbasket.is_standing, aqbasket.create_items";
714 unless ( $allbaskets ) {
715 # Don't show the basket if it's NOT CLOSED or is FULLY RECEIVED
716 $query.=" HAVING (closedate IS NULL OR (
718 IF(aqorders.datereceived IS NULL
719 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
725 my $sth = $dbh->prepare($query);
726 $sth->execute($supplierid);
727 my $baskets = $sth->fetchall_arrayref({});
729 # Retrieve the number of biblios cancelled
730 my $cancelled_biblios = $dbh->selectall_hashref( q|
731 SELECT COUNT(DISTINCT(biblionumber)) AS total_biblios_cancelled, aqbasket.basketno
733 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
734 WHERE booksellerid = ?
735 AND aqorders.orderstatus = 'cancelled'
736 GROUP BY aqbasket.basketno
737 |, 'basketno', {}, $supplierid );
739 $_->{total_biblios_cancelled} = $cancelled_biblios->{$_->{basketno}}{total_biblios_cancelled} || 0
745 =head3 GetBasketUsers
747 $basketusers_ids = &GetBasketUsers($basketno);
749 Returns a list of all borrowernumbers that are in basket users list
754 my $basketno = shift;
756 return unless $basketno;
759 SELECT borrowernumber
763 my $dbh = C4::Context->dbh;
764 my $sth = $dbh->prepare($query);
765 $sth->execute($basketno);
766 my $results = $sth->fetchall_arrayref( {} );
769 foreach (@$results) {
770 push @borrowernumbers, $_->{'borrowernumber'};
773 return @borrowernumbers;
776 =head3 ModBasketUsers
778 my @basketusers_ids = (1, 2, 3);
779 &ModBasketUsers($basketno, @basketusers_ids);
781 Delete all users from basket users list, and add users in C<@basketusers_ids>
787 my ($basketno, @basketusers_ids) = @_;
789 return unless $basketno;
791 my $dbh = C4::Context->dbh;
793 DELETE FROM aqbasketusers
796 my $sth = $dbh->prepare($query);
797 $sth->execute($basketno);
800 INSERT INTO aqbasketusers (basketno, borrowernumber)
803 $sth = $dbh->prepare($query);
804 foreach my $basketuser_id (@basketusers_ids) {
805 $sth->execute($basketno, $basketuser_id);
810 =head3 CanUserManageBasket
812 my $bool = CanUserManageBasket($borrower, $basket[, $userflags]);
813 my $bool = CanUserManageBasket($borrowernumber, $basketno[, $userflags]);
815 Check if a borrower can manage a basket, according to system preference
816 AcqViewBaskets, user permissions and basket properties (creator, users list,
819 First parameter can be either a borrowernumber or a hashref as returned by
820 Koha::Patron->unblessed
822 Second parameter can be either a basketno or a hashref as returned by
823 C4::Acquisition::GetBasket.
825 The third parameter is optional. If given, it should be a hashref as returned
826 by C4::Auth::getuserflags. If not, getuserflags is called.
828 If user is authorised to manage basket, returns 1.
833 sub CanUserManageBasket {
834 my ($borrower, $basket, $userflags) = @_;
836 if (!ref $borrower) {
837 # FIXME This needs to be replaced
838 # We should not accept both scalar and array
839 # Tests need to be updated
840 $borrower = Koha::Patrons->find( $borrower )->unblessed;
843 $basket = GetBasket($basket);
846 return 0 unless ($basket and $borrower);
848 my $borrowernumber = $borrower->{borrowernumber};
849 my $basketno = $basket->{basketno};
851 my $AcqViewBaskets = C4::Context->preference('AcqViewBaskets');
853 if (!defined $userflags) {
854 my $dbh = C4::Context->dbh;
855 my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE borrowernumber = ?");
856 $sth->execute($borrowernumber);
857 my ($flags) = $sth->fetchrow_array;
860 $userflags = C4::Auth::getuserflags($flags, $borrower->{userid}, $dbh);
863 unless ($userflags->{superlibrarian}
864 || (ref $userflags->{acquisition} && $userflags->{acquisition}->{order_manage_all})
865 || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
867 if (not exists $userflags->{acquisition}) {
871 if ( (ref $userflags->{acquisition} && !$userflags->{acquisition}->{order_manage})
872 || (!ref $userflags->{acquisition} && !$userflags->{acquisition}) ) {
876 if ($AcqViewBaskets eq 'user'
877 && $basket->{authorisedby} != $borrowernumber
878 && ! grep { $borrowernumber eq $_ } GetBasketUsers($basketno)) {
882 if ($AcqViewBaskets eq 'branch' && defined $basket->{branch}
883 && $basket->{branch} ne $borrower->{branchcode}) {
891 #------------------------------------------------------------#
893 =head3 GetBasketsByBasketgroup
895 $baskets = &GetBasketsByBasketgroup($basketgroupid);
897 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
901 sub GetBasketsByBasketgroup {
902 my $basketgroupid = shift;
904 SELECT *, aqbasket.booksellerid as booksellerid
906 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?
908 my $dbh = C4::Context->dbh;
909 my $sth = $dbh->prepare($query);
910 $sth->execute($basketgroupid);
911 return $sth->fetchall_arrayref({});
914 #------------------------------------------------------------#
916 =head3 NewBasketgroup
918 $basketgroupid = NewBasketgroup(\%hashref);
920 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
922 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
924 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
926 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
928 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
930 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
932 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
934 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
936 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
941 my $basketgroupinfo = shift;
942 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
943 my $query = "INSERT INTO aqbasketgroups (";
945 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
946 if ( defined $basketgroupinfo->{$field} ) {
947 $query .= "$field, ";
948 push(@params, $basketgroupinfo->{$field});
951 $query .= "booksellerid) VALUES (";
956 push(@params, $basketgroupinfo->{'booksellerid'});
957 my $dbh = C4::Context->dbh;
958 my $sth = $dbh->prepare($query);
959 $sth->execute(@params);
960 my $basketgroupid = $dbh->{'mysql_insertid'};
961 if( $basketgroupinfo->{'basketlist'} ) {
962 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
963 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
964 my $sth2 = $dbh->prepare($query2);
965 $sth2->execute($basketgroupid, $basketno);
968 return $basketgroupid;
971 #------------------------------------------------------------#
973 =head3 ModBasketgroup
975 ModBasketgroup(\%hashref);
977 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
979 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
981 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
983 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
985 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
987 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
989 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
991 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
993 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
998 my $basketgroupinfo = shift;
999 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
1000 my $dbh = C4::Context->dbh;
1001 my $query = "UPDATE aqbasketgroups SET ";
1003 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
1004 if ( defined $basketgroupinfo->{$field} ) {
1005 $query .= "$field=?, ";
1006 push(@params, $basketgroupinfo->{$field});
1011 $query .= " WHERE id=?";
1012 push(@params, $basketgroupinfo->{'id'});
1013 my $sth = $dbh->prepare($query);
1014 $sth->execute(@params);
1016 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
1017 $sth->execute($basketgroupinfo->{'id'});
1019 if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
1020 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
1021 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
1022 $sth->execute($basketgroupinfo->{'id'}, $basketno);
1028 #------------------------------------------------------------#
1030 =head3 DelBasketgroup
1032 DelBasketgroup($basketgroupid);
1034 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
1038 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
1044 sub DelBasketgroup {
1045 my $basketgroupid = shift;
1046 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1047 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
1048 my $dbh = C4::Context->dbh;
1049 my $sth = $dbh->prepare($query);
1050 $sth->execute($basketgroupid);
1054 #------------------------------------------------------------#
1057 =head2 FUNCTIONS ABOUT ORDERS
1059 =head3 GetBasketgroup
1061 $basketgroup = &GetBasketgroup($basketgroupid);
1063 Returns a reference to the hash containing all information about the basketgroup.
1067 sub GetBasketgroup {
1068 my $basketgroupid = shift;
1069 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1070 my $dbh = C4::Context->dbh;
1071 my $result_set = $dbh->selectall_arrayref(
1072 'SELECT * FROM aqbasketgroups WHERE id=?',
1076 return $result_set->[0]; # id is unique
1079 #------------------------------------------------------------#
1081 =head3 GetBasketgroups
1083 $basketgroups = &GetBasketgroups($booksellerid);
1085 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
1089 sub GetBasketgroups {
1090 my $booksellerid = shift;
1091 die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
1092 my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
1093 my $dbh = C4::Context->dbh;
1094 my $sth = $dbh->prepare($query);
1095 $sth->execute($booksellerid);
1096 return $sth->fetchall_arrayref({});
1099 #------------------------------------------------------------#
1101 =head2 FUNCTIONS ABOUT ORDERS
1105 @orders = &GetOrders( $basketno, { orderby => 'biblio.title', cancelled => 0|1 } );
1107 Looks up the pending (non-cancelled) orders with the given basket
1110 If cancelled is set, only cancelled orders will be returned.
1115 my ( $basketno, $params ) = @_;
1117 return () unless $basketno;
1119 my $orderby = $params->{orderby};
1120 my $cancelled = $params->{cancelled} || 0;
1122 my $dbh = C4::Context->dbh;
1124 SELECT biblio.*,biblioitems.*,
1128 $query .= $cancelled
1130 aqorders_transfers.ordernumber_to AS transferred_to,
1131 aqorders_transfers.timestamp AS transferred_to_timestamp
1134 aqorders_transfers.ordernumber_from AS transferred_from,
1135 aqorders_transfers.timestamp AS transferred_from_timestamp
1139 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1140 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1141 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1143 $query .= $cancelled
1145 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
1148 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1156 $orderby ||= q|biblioitems.publishercode, biblio.title|;
1158 AND (datecancellationprinted IS NOT NULL
1159 AND datecancellationprinted <> '0000-00-00')
1164 q|aqorders.datecancellationprinted desc, aqorders.timestamp desc|;
1166 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
1170 $query .= " ORDER BY $orderby";
1172 $dbh->selectall_arrayref( $query, { Slice => {} }, $basketno );
1177 #------------------------------------------------------------#
1179 =head3 GetOrdersByBiblionumber
1181 @orders = &GetOrdersByBiblionumber($biblionumber);
1183 Looks up the orders with linked to a specific $biblionumber, including
1184 cancelled orders and received orders.
1187 C<@orders> is an array of references-to-hash, whose keys are the
1188 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
1192 sub GetOrdersByBiblionumber {
1193 my $biblionumber = shift;
1194 return unless $biblionumber;
1195 my $dbh = C4::Context->dbh;
1197 SELECT biblio.*,biblioitems.*,
1201 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1202 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1203 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1204 WHERE aqorders.biblionumber=?
1207 $dbh->selectall_arrayref( $query, { Slice => {} }, $biblionumber );
1208 return @{$result_set};
1212 #------------------------------------------------------------#
1216 $order = &GetOrder($ordernumber);
1218 Looks up an order by order number.
1220 Returns a reference-to-hash describing the order. The keys of
1221 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1226 my ($ordernumber) = @_;
1227 return unless $ordernumber;
1229 my $dbh = C4::Context->dbh;
1230 my $query = qq{SELECT
1234 aqbasket.basketname,
1235 borrowers.branchcode,
1236 biblioitems.publicationyear,
1237 biblio.copyrightdate,
1238 biblioitems.editionstatement,
1242 biblioitems.publishercode,
1243 aqorders.rrp AS unitpricesupplier,
1244 aqorders.ecost AS unitpricelib,
1245 aqorders.claims_count AS claims_count,
1246 aqorders.claimed_date AS claimed_date,
1247 aqbudgets.budget_name AS budget,
1248 aqbooksellers.name AS supplier,
1249 aqbooksellers.id AS supplierid,
1250 biblioitems.publishercode AS publisher,
1251 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1252 DATE(aqbasket.closedate) AS orderdate,
1253 aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity_to_receive,
1254 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1255 DATEDIFF(CURDATE( ),closedate) AS latesince
1256 FROM aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1257 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1258 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1259 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
1260 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1261 WHERE aqorders.basketno = aqbasket.basketno
1264 $dbh->selectall_arrayref( $query, { Slice => {} }, $ordernumber );
1266 # result_set assumed to contain 1 match
1267 return $result_set->[0];
1270 =head3 GetLastOrderNotReceivedFromSubscriptionid
1272 $order = &GetLastOrderNotReceivedFromSubscriptionid($subscriptionid);
1274 Returns a reference-to-hash describing the last order not received for a subscription.
1278 sub GetLastOrderNotReceivedFromSubscriptionid {
1279 my ( $subscriptionid ) = @_;
1280 my $dbh = C4::Context->dbh;
1282 SELECT * FROM aqorders
1283 LEFT JOIN subscription
1284 ON ( aqorders.subscriptionid = subscription.subscriptionid )
1285 WHERE aqorders.subscriptionid = ?
1286 AND aqorders.datereceived IS NULL
1290 $dbh->selectall_arrayref( $query, { Slice => {} }, $subscriptionid );
1292 # result_set assumed to contain 1 match
1293 return $result_set->[0];
1296 =head3 GetLastOrderReceivedFromSubscriptionid
1298 $order = &GetLastOrderReceivedFromSubscriptionid($subscriptionid);
1300 Returns a reference-to-hash describing the last order received for a subscription.
1304 sub GetLastOrderReceivedFromSubscriptionid {
1305 my ( $subscriptionid ) = @_;
1306 my $dbh = C4::Context->dbh;
1308 SELECT * FROM aqorders
1309 LEFT JOIN subscription
1310 ON ( aqorders.subscriptionid = subscription.subscriptionid )
1311 WHERE aqorders.subscriptionid = ?
1312 AND aqorders.datereceived =
1314 SELECT MAX( aqorders.datereceived )
1316 LEFT JOIN subscription
1317 ON ( aqorders.subscriptionid = subscription.subscriptionid )
1318 WHERE aqorders.subscriptionid = ?
1319 AND aqorders.datereceived IS NOT NULL
1321 ORDER BY ordernumber DESC
1325 $dbh->selectall_arrayref( $query, { Slice => {} }, $subscriptionid, $subscriptionid );
1327 # result_set assumed to contain 1 match
1328 return $result_set->[0];
1332 #------------------------------------------------------------#
1336 &ModOrder(\%hashref);
1338 Modifies an existing order. Updates the order with order number
1339 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1340 other keys of the hash update the fields with the same name in the aqorders
1341 table of the Koha database.
1346 my $orderinfo = shift;
1348 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '';
1350 my $dbh = C4::Context->dbh;
1353 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1354 $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1356 # delete($orderinfo->{'branchcode'});
1357 # the hash contains a lot of entries not in aqorders, so get the columns ...
1358 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1360 my $colnames = $sth->{NAME};
1361 #FIXME Be careful. If aqorders would have columns with diacritics,
1362 #you should need to decode what you get back from NAME.
1363 #See report 10110 and guided_reports.pl
1364 my $query = "UPDATE aqorders SET ";
1366 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1367 # ... and skip hash entries that are not in the aqorders table
1368 # FIXME : probably not the best way to do it (would be better to have a correct hash)
1369 next unless grep(/^$orderinfokey$/, @$colnames);
1370 $query .= "$orderinfokey=?, ";
1371 push(@params, $orderinfo->{$orderinfokey});
1374 $query .= "timestamp=NOW() WHERE ordernumber=?";
1375 push(@params, $orderinfo->{'ordernumber'} );
1376 $sth = $dbh->prepare($query);
1377 $sth->execute(@params);
1381 #------------------------------------------------------------#
1385 ModItemOrder($itemnumber, $ordernumber);
1387 Modifies the ordernumber of an item in aqorders_items.
1392 my ($itemnumber, $ordernumber) = @_;
1394 return unless ($itemnumber and $ordernumber);
1396 my $dbh = C4::Context->dbh;
1398 UPDATE aqorders_items
1400 WHERE itemnumber = ?
1402 my $sth = $dbh->prepare($query);
1403 return $sth->execute($ordernumber, $itemnumber);
1406 #------------------------------------------------------------#
1408 =head3 ModReceiveOrder
1410 my ( $date_received, $new_ordernumber ) = ModReceiveOrder(
1412 biblionumber => $biblionumber,
1414 quantityreceived => $quantityreceived,
1416 invoice => $invoice,
1417 budget_id => $budget_id,
1418 received_itemnumbers => \@received_itemnumbers,
1419 order_internalnote => $order_internalnote,
1423 Updates an order, to reflect the fact that it was received, at least
1426 If a partial order is received, splits the order into two.
1428 Updates the order with biblionumber C<$biblionumber> and ordernumber
1429 C<$order->{ordernumber}>.
1434 sub ModReceiveOrder {
1436 my $biblionumber = $params->{biblionumber};
1437 my $order = { %{ $params->{order} } }; # Copy the order, we don't want to modify it
1438 my $invoice = $params->{invoice};
1439 my $quantrec = $params->{quantityreceived};
1440 my $user = $params->{user};
1441 my $budget_id = $params->{budget_id};
1442 my $received_items = $params->{received_items};
1444 my $dbh = C4::Context->dbh;
1445 my $datereceived = ( $invoice and $invoice->{datereceived} ) ? $invoice->{datereceived} : dt_from_string;
1446 my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1447 if ($suggestionid) {
1448 ModSuggestion( {suggestionid=>$suggestionid,
1449 STATUS=>'AVAILABLE',
1450 biblionumber=> $biblionumber}
1454 my $result_set = $dbh->selectrow_arrayref(
1455 q{SELECT aqbasket.is_standing
1457 WHERE basketno=?},{ Slice => {} }, $order->{basketno});
1458 my $is_standing = $result_set->[0]; # we assume we have a unique basket
1460 my $new_ordernumber = $order->{ordernumber};
1461 if ( $is_standing || $order->{quantity} > $quantrec ) {
1462 # Split order line in two parts: the first is the original order line
1463 # without received items (the quantity is decreased),
1464 # the second part is a new order line with quantity=quantityrec
1465 # (entirely received)
1469 orderstatus = 'partial'|;
1470 $query .= q|, order_internalnote = ?| if defined $order->{order_internalnote};
1471 $query .= q| WHERE ordernumber = ?|;
1472 my $sth = $dbh->prepare($query);
1475 ( $is_standing ? 1 : ($order->{quantity} - $quantrec) ),
1476 ( defined $order->{order_internalnote} ? $order->{order_internalnote} : () ),
1477 $order->{ordernumber}
1480 # Recalculate tax_value
1484 tax_value_on_ordering = quantity * ecost_tax_excluded * tax_rate_on_ordering,
1485 tax_value_on_receiving = quantity * unitprice_tax_excluded * tax_rate_on_receiving
1486 WHERE ordernumber = ?
1487 |, undef, $order->{ordernumber});
1489 delete $order->{ordernumber};
1490 $order->{budget_id} = ( $budget_id || $order->{budget_id} );
1491 $order->{quantity} = $quantrec;
1492 $order->{quantityreceived} = $quantrec;
1493 $order->{ecost_tax_excluded} //= 0;
1494 $order->{tax_rate_on_ordering} //= 0;
1495 $order->{unitprice_tax_excluded} //= 0;
1496 $order->{tax_rate_on_receiving} //= 0;
1497 $order->{tax_value_on_ordering} = $order->{quantity} * $order->{ecost_tax_excluded} * $order->{tax_rate_on_ordering};
1498 $order->{tax_value_on_receiving} = $order->{quantity} * $order->{unitprice_tax_excluded} * $order->{tax_rate_on_receiving};
1499 $order->{datereceived} = $datereceived;
1500 $order->{invoiceid} = $invoice->{invoiceid};
1501 $order->{orderstatus} = 'complete';
1502 $new_ordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber; # TODO What if the store fails?
1504 if ($received_items) {
1505 foreach my $itemnumber (@$received_items) {
1506 ModItemOrder($itemnumber, $new_ordernumber);
1512 SET quantityreceived = ?,
1516 orderstatus = 'complete'
1520 , replacementprice = ?
1521 | if defined $order->{replacementprice};
1524 , unitprice = ?, unitprice_tax_included = ?, unitprice_tax_excluded = ?
1525 | if defined $order->{unitprice};
1528 ,tax_value_on_receiving = ?
1529 | if defined $order->{tax_value_on_receiving};
1532 ,tax_rate_on_receiving = ?
1533 | if defined $order->{tax_rate_on_receiving};
1536 , order_internalnote = ?
1537 | if defined $order->{order_internalnote};
1539 $query .= q| where biblionumber=? and ordernumber=?|;
1541 my $sth = $dbh->prepare( $query );
1542 my @params = ( $quantrec, $datereceived, $invoice->{invoiceid}, ( $budget_id ? $budget_id : $order->{budget_id} ) );
1544 if ( defined $order->{replacementprice} ) {
1545 push @params, $order->{replacementprice};
1548 if ( defined $order->{unitprice} ) {
1549 push @params, $order->{unitprice}, $order->{unitprice_tax_included}, $order->{unitprice_tax_excluded};
1552 if ( defined $order->{tax_value_on_receiving} ) {
1553 push @params, $order->{tax_value_on_receiving};
1556 if ( defined $order->{tax_rate_on_receiving} ) {
1557 push @params, $order->{tax_rate_on_receiving};
1560 if ( defined $order->{order_internalnote} ) {
1561 push @params, $order->{order_internalnote};
1564 push @params, ( $biblionumber, $order->{ordernumber} );
1566 $sth->execute( @params );
1568 # All items have been received, sent a notification to users
1569 NotifyOrderUsers( $order->{ordernumber} );
1572 return ($datereceived, $new_ordernumber);
1575 =head3 CancelReceipt
1577 my $parent_ordernumber = CancelReceipt($ordernumber);
1579 Cancel an order line receipt and update the parent order line, as if no
1581 If items are created at receipt (AcqCreateItem = receiving) then delete
1587 my $ordernumber = shift;
1589 return unless $ordernumber;
1591 my $dbh = C4::Context->dbh;
1593 SELECT datereceived, parent_ordernumber, quantity
1595 WHERE ordernumber = ?
1597 my $sth = $dbh->prepare($query);
1598 $sth->execute($ordernumber);
1599 my $order = $sth->fetchrow_hashref;
1601 warn "CancelReceipt: order $ordernumber does not exist";
1604 unless($order->{'datereceived'}) {
1605 warn "CancelReceipt: order $ordernumber is not received";
1609 my $parent_ordernumber = $order->{'parent_ordernumber'};
1611 my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1612 my $order_obj = Koha::Acquisition::Orders->find( $ordernumber ); # FIXME rewrite all this subroutine using this object
1614 if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1615 # The order line has no parent, just mark it as not received
1618 SET quantityreceived = ?,
1621 orderstatus = 'ordered'
1622 WHERE ordernumber = ?
1624 $sth = $dbh->prepare($query);
1625 $sth->execute(0, undef, undef, $ordernumber);
1626 _cancel_items_receipt( $order_obj );
1628 # The order line has a parent, increase parent quantity and delete
1631 SELECT quantity, datereceived
1633 WHERE ordernumber = ?
1635 $sth = $dbh->prepare($query);
1636 $sth->execute($parent_ordernumber);
1637 my $parent_order = $sth->fetchrow_hashref;
1638 unless($parent_order) {
1639 warn "Parent order $parent_ordernumber does not exist.";
1642 if($parent_order->{'datereceived'}) {
1643 warn "CancelReceipt: parent order is received.".
1644 " Can't cancel receipt.";
1650 orderstatus = 'ordered'
1651 WHERE ordernumber = ?
1653 $sth = $dbh->prepare($query);
1654 my $rv = $sth->execute(
1655 $order->{'quantity'} + $parent_order->{'quantity'},
1659 warn "Cannot update parent order line, so do not cancel".
1664 # Recalculate tax_value
1668 tax_value_on_ordering = quantity * ecost_tax_excluded * tax_rate_on_ordering,
1669 tax_value_on_receiving = quantity * unitprice_tax_excluded * tax_rate_on_receiving
1670 WHERE ordernumber = ?
1671 |, undef, $parent_ordernumber);
1673 _cancel_items_receipt( $order_obj, $parent_ordernumber );
1676 DELETE FROM aqorders
1677 WHERE ordernumber = ?
1679 $sth = $dbh->prepare($query);
1680 $sth->execute($ordernumber);
1684 if( $order_obj->basket->effective_create_items eq 'ordering' ) {
1685 my @affects = split q{\|}, C4::Context->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1687 for my $in ( @itemnumbers ) {
1688 my $item = Koha::Items->find( $in );
1689 my $biblio = $item->biblio;
1690 my ( $itemfield ) = GetMarcFromKohaField( 'items.itemnumber', $biblio->frameworkcode );
1691 my $item_marc = C4::Items::GetMarcItem( $biblio->biblionumber, $in );
1692 for my $affect ( @affects ) {
1693 my ( $sf, $v ) = split q{=}, $affect, 2;
1694 foreach ( $item_marc->field($itemfield) ) {
1695 $_->update( $sf => $v );
1698 C4::Items::ModItemFromMarc( $item_marc, $biblio->biblionumber, $in );
1703 return $parent_ordernumber;
1706 sub _cancel_items_receipt {
1707 my ( $order, $parent_ordernumber ) = @_;
1708 $parent_ordernumber ||= $order->ordernumber;
1710 my @itemnumbers = GetItemnumbersFromOrder($order->ordernumber); # FIXME Must be $order->items
1711 if ( $order->basket->effective_create_items eq 'receiving' ) {
1712 # Remove items that were created at receipt
1714 DELETE FROM items, aqorders_items
1715 USING items, aqorders_items
1716 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1718 my $dbh = C4::Context->dbh;
1719 my $sth = $dbh->prepare($query);
1720 foreach my $itemnumber (@itemnumbers) {
1721 $sth->execute($itemnumber, $itemnumber);
1725 foreach my $itemnumber (@itemnumbers) {
1726 ModItemOrder($itemnumber, $parent_ordernumber);
1731 #------------------------------------------------------------#
1735 @results = &SearchOrders({
1736 ordernumber => $ordernumber,
1739 booksellerid => $booksellerid,
1740 basketno => $basketno,
1741 basketname => $basketname,
1742 basketgroupname => $basketgroupname,
1746 biblionumber => $biblionumber,
1747 budget_id => $budget_id
1750 Searches for orders filtered by criteria.
1752 C<$ordernumber> Finds matching orders or transferred orders by ordernumber.
1753 C<$search> Finds orders matching %$search% in title, author, or isbn.
1754 C<$owner> Finds order for the logged in user.
1755 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1756 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1759 C<@results> is an array of references-to-hash with the keys are fields
1760 from aqorders, biblio, biblioitems and aqbasket tables.
1765 my ( $params ) = @_;
1766 my $ordernumber = $params->{ordernumber};
1767 my $search = $params->{search};
1768 my $ean = $params->{ean};
1769 my $booksellerid = $params->{booksellerid};
1770 my $basketno = $params->{basketno};
1771 my $basketname = $params->{basketname};
1772 my $basketgroupname = $params->{basketgroupname};
1773 my $owner = $params->{owner};
1774 my $pending = $params->{pending};
1775 my $ordered = $params->{ordered};
1776 my $biblionumber = $params->{biblionumber};
1777 my $budget_id = $params->{budget_id};
1779 my $dbh = C4::Context->dbh;
1782 SELECT aqbasket.basketno,
1784 borrowers.firstname,
1787 biblioitems.biblioitemnumber,
1788 biblioitems.publishercode,
1789 biblioitems.publicationyear,
1790 aqbasket.authorisedby,
1791 aqbasket.booksellerid,
1793 aqbasket.creationdate,
1794 aqbasket.basketname,
1795 aqbasketgroups.id as basketgroupid,
1796 aqbasketgroups.name as basketgroupname,
1799 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1800 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1801 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1802 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1803 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1806 # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
1808 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1812 WHERE (datecancellationprinted is NULL)
1815 if ( $pending or $ordered ) {
1818 ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) )
1820 ( quantity > quantityreceived OR quantityreceived is NULL )
1824 $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1832 my $userenv = C4::Context->userenv;
1833 if ( C4::Context->preference("IndependentBranches") ) {
1834 unless ( C4::Context->IsSuperLibrarian() ) {
1837 borrowers.branchcode = ?
1838 OR borrowers.branchcode = ''
1841 push @args, $userenv->{branch};
1845 if ( $ordernumber ) {
1846 $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1847 push @args, ( $ordernumber, $ordernumber );
1849 if ( $biblionumber ) {
1850 $query .= 'AND aqorders.biblionumber = ?';
1851 push @args, $biblionumber;
1854 $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1855 push @args, ("%$search%","%$search%","%$search%");
1858 $query .= ' AND biblioitems.ean = ?';
1861 if ( $booksellerid ) {
1862 $query .= 'AND aqbasket.booksellerid = ?';
1863 push @args, $booksellerid;
1866 $query .= 'AND aqbasket.basketno = ?';
1867 push @args, $basketno;
1870 $query .= 'AND aqbasket.basketname LIKE ?';
1871 push @args, "%$basketname%";
1873 if( $basketgroupname ) {
1874 $query .= ' AND aqbasketgroups.name LIKE ?';
1875 push @args, "%$basketgroupname%";
1879 $query .= ' AND aqbasket.authorisedby=? ';
1880 push @args, $userenv->{'number'};
1884 $query .= ' AND aqorders.budget_id = ?';
1885 push @args, $budget_id;
1888 $query .= ' ORDER BY aqbasket.basketno';
1890 my $sth = $dbh->prepare($query);
1891 $sth->execute(@args);
1892 return $sth->fetchall_arrayref({});
1895 #------------------------------------------------------------#
1899 &DelOrder($biblionumber, $ordernumber);
1901 Cancel the order with the given order and biblio numbers. It does not
1902 delete any entries in the aqorders table, it merely marks them as
1908 my ( $bibnum, $ordernumber, $delete_biblio, $reason ) = @_;
1911 my $dbh = C4::Context->dbh;
1914 SET datecancellationprinted=now(), orderstatus='cancelled'
1917 $query .= ", cancellationreason = ? ";
1920 WHERE biblionumber=? AND ordernumber=?
1922 my $sth = $dbh->prepare($query);
1924 $sth->execute($reason, $bibnum, $ordernumber);
1926 $sth->execute( $bibnum, $ordernumber );
1930 my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1931 foreach my $itemnumber (@itemnumbers){
1932 my $delcheck = C4::Items::DelItemCheck( $bibnum, $itemnumber );
1934 if($delcheck != 1) {
1935 $error->{'delitem'} = 1;
1939 if($delete_biblio) {
1940 # We get the number of remaining items
1941 my $biblio = Koha::Biblios->find( $bibnum );
1942 my $itemcount = $biblio->items->count;
1944 # If there are no items left,
1945 if ( $itemcount == 0 ) {
1946 # We delete the record
1947 my $delcheck = DelBiblio($bibnum);
1950 $error->{'delbiblio'} = 1;
1958 =head3 TransferOrder
1960 my $newordernumber = TransferOrder($ordernumber, $basketno);
1962 Transfer an order line to a basket.
1963 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1964 to BOOKSELLER on DATE' and create new order with internal note
1965 'Transferred from BOOKSELLER on DATE'.
1966 Move all attached items to the new order.
1967 Received orders cannot be transferred.
1968 Return the ordernumber of created order.
1973 my ($ordernumber, $basketno) = @_;
1975 return unless ($ordernumber and $basketno);
1977 my $order = Koha::Acquisition::Orders->find( $ordernumber ) or return;
1978 return if $order->datereceived;
1980 $order = $order->unblessed;
1982 my $basket = GetBasket($basketno);
1983 return unless $basket;
1985 my $dbh = C4::Context->dbh;
1986 my ($query, $sth, $rv);
1990 SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1991 WHERE ordernumber = ?
1993 $sth = $dbh->prepare($query);
1994 $rv = $sth->execute('cancelled', $ordernumber);
1996 delete $order->{'ordernumber'};
1997 delete $order->{parent_ordernumber};
1998 $order->{'basketno'} = $basketno;
2000 my $newordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber;
2003 UPDATE aqorders_items
2005 WHERE ordernumber = ?
2007 $sth = $dbh->prepare($query);
2008 $sth->execute($newordernumber, $ordernumber);
2011 INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
2014 $sth = $dbh->prepare($query);
2015 $sth->execute($ordernumber, $newordernumber);
2017 return $newordernumber;
2020 =head2 FUNCTIONS ABOUT PARCELS
2024 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
2026 get a lists of parcels.
2033 is the bookseller this function has to get parcels.
2036 To know on what criteria the results list has to be ordered.
2039 is the booksellerinvoicenumber.
2041 =item $datefrom & $dateto
2042 to know on what date this function has to filter its search.
2047 a pointer on a hash list containing parcel informations as such :
2053 =item Last operation
2055 =item Number of biblio
2057 =item Number of items
2064 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
2065 my $dbh = C4::Context->dbh;
2066 my @query_params = ();
2068 SELECT aqinvoices.invoicenumber,
2069 datereceived,purchaseordernumber,
2070 count(DISTINCT biblionumber) AS biblio,
2071 sum(quantity) AS itemsexpected,
2072 sum(quantityreceived) AS itemsreceived
2073 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
2074 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2075 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
2077 push @query_params, $bookseller;
2079 if ( defined $code ) {
2080 $strsth .= ' and aqinvoices.invoicenumber like ? ';
2081 # add a % to the end of the code to allow stemming.
2082 push @query_params, "$code%";
2085 if ( defined $datefrom ) {
2086 $strsth .= ' and datereceived >= ? ';
2087 push @query_params, $datefrom;
2090 if ( defined $dateto ) {
2091 $strsth .= 'and datereceived <= ? ';
2092 push @query_params, $dateto;
2095 $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
2097 # can't use a placeholder to place this column name.
2098 # but, we could probably be checking to make sure it is a column that will be fetched.
2099 $strsth .= "order by $order " if ($order);
2101 my $sth = $dbh->prepare($strsth);
2103 $sth->execute( @query_params );
2104 my $results = $sth->fetchall_arrayref({});
2108 #------------------------------------------------------------#
2110 =head3 GetLateOrders
2112 @results = &GetLateOrders;
2114 Searches for bookseller with late orders.
2117 the table of supplier with late issues. This table is full of hashref.
2123 my $supplierid = shift;
2125 my $estimateddeliverydatefrom = shift;
2126 my $estimateddeliverydateto = shift;
2128 my $dbh = C4::Context->dbh;
2130 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
2131 my $dbdriver = C4::Context->config("db_scheme") || "mysql";
2133 my @query_params = ();
2135 SELECT aqbasket.basketno,
2136 aqorders.ordernumber,
2137 DATE(aqbasket.closedate) AS orderdate,
2138 aqbasket.basketname AS basketname,
2139 aqbasket.basketgroupid AS basketgroupid,
2140 aqbasketgroups.name AS basketgroupname,
2141 aqorders.rrp AS unitpricesupplier,
2142 aqorders.ecost AS unitpricelib,
2143 aqorders.claims_count AS claims_count,
2144 aqorders.claimed_date AS claimed_date,
2145 aqbudgets.budget_name AS budget,
2146 borrowers.branchcode AS branch,
2147 aqbooksellers.name AS supplier,
2148 aqbooksellers.id AS supplierid,
2149 biblio.author, biblio.title,
2150 biblioitems.publishercode AS publisher,
2151 biblioitems.publicationyear,
2152 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
2156 aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
2157 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
2158 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
2159 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
2160 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
2161 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2162 WHERE aqorders.basketno = aqbasket.basketno
2163 AND ( datereceived = ''
2164 OR datereceived IS NULL
2165 OR aqorders.quantityreceived < aqorders.quantity
2167 AND aqbasket.closedate IS NOT NULL
2168 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
2170 if ($dbdriver eq "mysql") {
2172 aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity,
2173 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
2174 DATEDIFF(CAST(now() AS date),closedate) AS latesince
2176 if ( defined $delay ) {
2177 $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
2178 push @query_params, $delay;
2180 $from .= " AND aqorders.quantity - COALESCE(aqorders.quantityreceived,0) <> 0";
2182 # FIXME: account for IFNULL as above
2184 aqorders.quantity AS quantity,
2185 aqorders.quantity * aqorders.rrp AS subtotal,
2186 (CAST(now() AS date) - closedate) AS latesince
2188 if ( defined $delay ) {
2189 $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
2190 push @query_params, $delay;
2192 $from .= " AND aqorders.quantity <> 0";
2194 if (defined $supplierid) {
2195 $from .= ' AND aqbasket.booksellerid = ? ';
2196 push @query_params, $supplierid;
2198 if (defined $branch) {
2199 $from .= ' AND borrowers.branchcode LIKE ? ';
2200 push @query_params, $branch;
2203 if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
2204 $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
2206 if ( defined $estimateddeliverydatefrom ) {
2207 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
2208 push @query_params, $estimateddeliverydatefrom;
2210 if ( defined $estimateddeliverydateto ) {
2211 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
2212 push @query_params, $estimateddeliverydateto;
2214 if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
2215 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
2217 if (C4::Context->preference("IndependentBranches")
2218 && !C4::Context->IsSuperLibrarian() ) {
2219 $from .= ' AND borrowers.branchcode LIKE ? ';
2220 push @query_params, C4::Context->userenv->{branch};
2222 $from .= " AND orderstatus <> 'cancelled' ";
2223 my $query = "$select $from \nORDER BY latesince, basketno, borrowers.branchcode, supplier";
2224 $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
2225 my $sth = $dbh->prepare($query);
2226 $sth->execute(@query_params);
2228 while (my $data = $sth->fetchrow_hashref) {
2229 push @results, $data;
2234 #------------------------------------------------------------#
2238 \@order_loop = GetHistory( %params );
2240 Retreives some acquisition history information
2250 basket - search both basket name and number
2251 booksellerinvoicenumber
2254 orderstatus (note that orderstatus '' will retrieve orders
2255 of any status except cancelled)
2257 get_canceled_order (if set to a true value, cancelled orders will
2261 $order_loop is a list of hashrefs that each look like this:
2263 'author' => 'Twain, Mark',
2265 'biblionumber' => '215',
2267 'creationdate' => 'MM/DD/YYYY',
2268 'datereceived' => undef,
2271 'invoicenumber' => undef,
2273 'ordernumber' => '1',
2275 'quantityreceived' => undef,
2276 'title' => 'The Adventures of Huckleberry Finn'
2282 # don't run the query if there are no parameters (list would be too long for sure !)
2283 croak "No search params" unless @_;
2285 my $title = $params{title};
2286 my $author = $params{author};
2287 my $isbn = $params{isbn};
2288 my $ean = $params{ean};
2289 my $name = $params{name};
2290 my $from_placed_on = $params{from_placed_on};
2291 my $to_placed_on = $params{to_placed_on};
2292 my $basket = $params{basket};
2293 my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2294 my $basketgroupname = $params{basketgroupname};
2295 my $budget = $params{budget};
2296 my $orderstatus = $params{orderstatus};
2297 my $biblionumber = $params{biblionumber};
2298 my $get_canceled_order = $params{get_canceled_order} || 0;
2299 my $ordernumber = $params{ordernumber};
2300 my $search_children_too = $params{search_children_too} || 0;
2301 my $created_by = $params{created_by} || [];
2305 my $total_qtyreceived = 0;
2306 my $total_price = 0;
2308 #get variation of isbn
2312 if ( C4::Context->preference("SearchWithISBNVariations") ){
2313 @isbns = C4::Koha::GetVariationsOfISBN( $isbn );
2314 foreach my $isb (@isbns){
2315 push @isbn_params, '?';
2320 push @isbn_params, '?';
2324 my $dbh = C4::Context->dbh;
2327 COALESCE(biblio.title, deletedbiblio.title) AS title,
2328 COALESCE(biblio.author, deletedbiblio.author) AS author,
2329 COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2330 COALESCE(biblioitems.ean, deletedbiblioitems.ean) AS ean,
2332 aqbasket.basketname,
2333 aqbasket.basketgroupid,
2334 aqbasket.authorisedby,
2335 concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2336 aqbasketgroups.name as groupname,
2338 aqbasket.creationdate,
2339 aqorders.datereceived,
2341 aqorders.quantityreceived,
2343 aqorders.ordernumber,
2345 aqinvoices.invoicenumber,
2346 aqbooksellers.id as id,
2347 aqorders.biblionumber,
2348 aqorders.orderstatus,
2349 aqorders.parent_ordernumber,
2350 aqbudgets.budget_name
2352 $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2355 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2356 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2357 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2358 LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2359 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2360 LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2361 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2362 LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2363 LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2364 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2367 $query .= " WHERE 1 ";
2369 unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2370 $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2373 my @query_params = ();
2375 if ( $biblionumber ) {
2376 $query .= " AND biblio.biblionumber = ?";
2377 push @query_params, $biblionumber;
2381 $query .= " AND biblio.title LIKE ? ";
2382 $title =~ s/\s+/%/g;
2383 push @query_params, "%$title%";
2387 $query .= " AND biblio.author LIKE ? ";
2388 push @query_params, "%$author%";
2392 $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2393 foreach my $isb (@isbns){
2394 push @query_params, "%$isb%";
2399 $query .= " AND biblioitems.ean = ? ";
2400 push @query_params, "$ean";
2403 $query .= " AND aqbooksellers.name LIKE ? ";
2404 push @query_params, "%$name%";
2408 $query .= " AND aqbudgets.budget_id = ? ";
2409 push @query_params, "$budget";
2412 if ( $from_placed_on ) {
2413 $query .= " AND creationdate >= ? ";
2414 push @query_params, $from_placed_on;
2417 if ( $to_placed_on ) {
2418 $query .= " AND creationdate <= ? ";
2419 push @query_params, $to_placed_on;
2422 if ( defined $orderstatus and $orderstatus ne '') {
2423 $query .= " AND aqorders.orderstatus = ? ";
2424 push @query_params, "$orderstatus";
2428 if ($basket =~ m/^\d+$/) {
2429 $query .= " AND aqorders.basketno = ? ";
2430 push @query_params, $basket;
2432 $query .= " AND aqbasket.basketname LIKE ? ";
2433 push @query_params, "%$basket%";
2437 if ($booksellerinvoicenumber) {
2438 $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2439 push @query_params, "%$booksellerinvoicenumber%";
2442 if ($basketgroupname) {
2443 $query .= " AND aqbasketgroups.name LIKE ? ";
2444 push @query_params, "%$basketgroupname%";
2448 $query .= " AND (aqorders.ordernumber = ? ";
2449 push @query_params, $ordernumber;
2450 if ($search_children_too) {
2451 $query .= " OR aqorders.parent_ordernumber = ? ";
2452 push @query_params, $ordernumber;
2457 if ( @$created_by ) {
2458 $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2459 push @query_params, @$created_by;
2463 if ( C4::Context->preference("IndependentBranches") ) {
2464 unless ( C4::Context->IsSuperLibrarian() ) {
2465 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2466 push @query_params, C4::Context->userenv->{branch};
2469 $query .= " ORDER BY id";
2471 return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2474 =head2 GetRecentAcqui
2476 $results = GetRecentAcqui($days);
2478 C<$results> is a ref to a table which contains hashref
2482 sub GetRecentAcqui {
2484 my $dbh = C4::Context->dbh;
2488 ORDER BY timestamp DESC
2491 my $sth = $dbh->prepare($query);
2493 my $results = $sth->fetchall_arrayref({});
2497 #------------------------------------------------------------#
2501 &AddClaim($ordernumber);
2503 Add a claim for an order
2508 my ($ordernumber) = @_;
2509 my $dbh = C4::Context->dbh;
2512 claims_count = claims_count + 1,
2513 claimed_date = CURDATE()
2514 WHERE ordernumber = ?
2516 my $sth = $dbh->prepare($query);
2517 $sth->execute($ordernumber);
2522 my @invoices = GetInvoices(
2523 invoicenumber => $invoicenumber,
2524 supplierid => $supplierid,
2525 suppliername => $suppliername,
2526 shipmentdatefrom => $shipmentdatefrom, # ISO format
2527 shipmentdateto => $shipmentdateto, # ISO format
2528 billingdatefrom => $billingdatefrom, # ISO format
2529 billingdateto => $billingdateto, # ISO format
2530 isbneanissn => $isbn_or_ean_or_issn,
2533 publisher => $publisher,
2534 publicationyear => $publicationyear,
2535 branchcode => $branchcode,
2536 order_by => $order_by
2539 Return a list of invoices that match all given criteria.
2541 $order_by is "column_name (asc|desc)", where column_name is any of
2542 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2543 'shipmentcost', 'shipmentcost_budgetid'.
2545 asc is the default if omitted
2552 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2553 closedate shipmentcost shipmentcost_budgetid);
2555 my $dbh = C4::Context->dbh;
2557 SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
2558 aqbooksellers.name AS suppliername,
2561 aqorders.datereceived IS NOT NULL,
2562 aqorders.biblionumber,
2565 ) AS receivedbiblios,
2568 aqorders.subscriptionid IS NOT NULL,
2569 aqorders.subscriptionid,
2572 ) AS is_linked_to_subscriptions,
2573 SUM(aqorders.quantityreceived) AS receiveditems
2575 LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2576 LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2577 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2578 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2579 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2580 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2581 LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2586 if($args{supplierid}) {
2587 push @bind_strs, " aqinvoices.booksellerid = ? ";
2588 push @bind_args, $args{supplierid};
2590 if($args{invoicenumber}) {
2591 push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2592 push @bind_args, "%$args{invoicenumber}%";
2594 if($args{suppliername}) {
2595 push @bind_strs, " aqbooksellers.name LIKE ? ";
2596 push @bind_args, "%$args{suppliername}%";
2598 if($args{shipmentdatefrom}) {
2599 push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2600 push @bind_args, $args{shipmentdatefrom};
2602 if($args{shipmentdateto}) {
2603 push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2604 push @bind_args, $args{shipmentdateto};
2606 if($args{billingdatefrom}) {
2607 push @bind_strs, " aqinvoices.billingdate >= ? ";
2608 push @bind_args, $args{billingdatefrom};
2610 if($args{billingdateto}) {
2611 push @bind_strs, " aqinvoices.billingdate <= ? ";
2612 push @bind_args, $args{billingdateto};
2614 if($args{isbneanissn}) {
2615 push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2616 push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2619 push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2620 push @bind_args, $args{title};
2623 push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2624 push @bind_args, $args{author};
2626 if($args{publisher}) {
2627 push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2628 push @bind_args, $args{publisher};
2630 if($args{publicationyear}) {
2631 push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2632 push @bind_args, $args{publicationyear}, $args{publicationyear};
2634 if($args{branchcode}) {
2635 push @bind_strs, " borrowers.branchcode = ? ";
2636 push @bind_args, $args{branchcode};
2638 if($args{message_id}) {
2639 push @bind_strs, " aqinvoices.message_id = ? ";
2640 push @bind_args, $args{message_id};
2643 $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2644 $query .= " GROUP BY aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id, aqbooksellers.name";
2646 if($args{order_by}) {
2647 my ($column, $direction) = split / /, $args{order_by};
2648 if(grep /^$column$/, @columns) {
2649 $direction ||= 'ASC';
2650 $query .= " ORDER BY $column $direction";
2654 my $sth = $dbh->prepare($query);
2655 $sth->execute(@bind_args);
2657 my $results = $sth->fetchall_arrayref({});
2663 my $invoice = GetInvoice($invoiceid);
2665 Get informations about invoice with given $invoiceid
2667 Return a hash filled with aqinvoices.* fields
2672 my ($invoiceid) = @_;
2675 return unless $invoiceid;
2677 my $dbh = C4::Context->dbh;
2683 my $sth = $dbh->prepare($query);
2684 $sth->execute($invoiceid);
2686 $invoice = $sth->fetchrow_hashref;
2690 =head3 GetInvoiceDetails
2692 my $invoice = GetInvoiceDetails($invoiceid)
2694 Return informations about an invoice + the list of related order lines
2696 Orders informations are in $invoice->{orders} (array ref)
2700 sub GetInvoiceDetails {
2701 my ($invoiceid) = @_;
2703 if ( !defined $invoiceid ) {
2704 carp 'GetInvoiceDetails called without an invoiceid';
2708 my $dbh = C4::Context->dbh;
2710 SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2712 LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2715 my $sth = $dbh->prepare($query);
2716 $sth->execute($invoiceid);
2718 my $invoice = $sth->fetchrow_hashref;
2723 biblio.copyrightdate,
2725 biblioitems.publishercode,
2726 biblioitems.publicationyear,
2727 aqbasket.basketname,
2728 aqbasketgroups.id AS basketgroupid,
2729 aqbasketgroups.name AS basketgroupname
2731 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2732 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2733 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2734 LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2737 $sth = $dbh->prepare($query);
2738 $sth->execute($invoiceid);
2739 $invoice->{orders} = $sth->fetchall_arrayref({});
2740 $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2747 my $invoiceid = AddInvoice(
2748 invoicenumber => $invoicenumber,
2749 booksellerid => $booksellerid,
2750 shipmentdate => $shipmentdate,
2751 billingdate => $billingdate,
2752 closedate => $closedate,
2753 shipmentcost => $shipmentcost,
2754 shipmentcost_budgetid => $shipmentcost_budgetid
2757 Create a new invoice and return its id or undef if it fails.
2764 return unless(%invoice and $invoice{invoicenumber});
2766 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2767 closedate shipmentcost shipmentcost_budgetid message_id);
2771 foreach my $key (keys %invoice) {
2772 if(0 < grep(/^$key$/, @columns)) {
2773 push @set_strs, "$key = ?";
2774 push @set_args, ($invoice{$key} || undef);
2780 my $dbh = C4::Context->dbh;
2781 my $query = "INSERT INTO aqinvoices SET ";
2782 $query .= join (",", @set_strs);
2783 my $sth = $dbh->prepare($query);
2784 $rv = $sth->execute(@set_args);
2786 $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2795 invoiceid => $invoiceid, # Mandatory
2796 invoicenumber => $invoicenumber,
2797 booksellerid => $booksellerid,
2798 shipmentdate => $shipmentdate,
2799 billingdate => $billingdate,
2800 closedate => $closedate,
2801 shipmentcost => $shipmentcost,
2802 shipmentcost_budgetid => $shipmentcost_budgetid
2805 Modify an invoice, invoiceid is mandatory.
2807 Return undef if it fails.
2814 return unless(%invoice and $invoice{invoiceid});
2816 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2817 closedate shipmentcost shipmentcost_budgetid);
2821 foreach my $key (keys %invoice) {
2822 if(0 < grep(/^$key$/, @columns)) {
2823 push @set_strs, "$key = ?";
2824 push @set_args, ($invoice{$key} || undef);
2828 my $dbh = C4::Context->dbh;
2829 my $query = "UPDATE aqinvoices SET ";
2830 $query .= join(",", @set_strs);
2831 $query .= " WHERE invoiceid = ?";
2833 my $sth = $dbh->prepare($query);
2834 $sth->execute(@set_args, $invoice{invoiceid});
2839 CloseInvoice($invoiceid);
2843 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2848 my ($invoiceid) = @_;
2850 return unless $invoiceid;
2852 my $dbh = C4::Context->dbh;
2855 SET closedate = CAST(NOW() AS DATE)
2858 my $sth = $dbh->prepare($query);
2859 $sth->execute($invoiceid);
2862 =head3 ReopenInvoice
2864 ReopenInvoice($invoiceid);
2868 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2873 my ($invoiceid) = @_;
2875 return unless $invoiceid;
2877 my $dbh = C4::Context->dbh;
2880 SET closedate = NULL
2883 my $sth = $dbh->prepare($query);
2884 $sth->execute($invoiceid);
2889 DelInvoice($invoiceid);
2891 Delete an invoice if there are no items attached to it.
2896 my ($invoiceid) = @_;
2898 return unless $invoiceid;
2900 my $dbh = C4::Context->dbh;
2906 my $sth = $dbh->prepare($query);
2907 $sth->execute($invoiceid);
2908 my $res = $sth->fetchrow_arrayref;
2909 if ( $res && $res->[0] == 0 ) {
2911 DELETE FROM aqinvoices
2914 my $sth = $dbh->prepare($query);
2915 return ( $sth->execute($invoiceid) > 0 );
2920 =head3 MergeInvoices
2922 MergeInvoices($invoiceid, \@sourceids);
2924 Merge the invoices identified by the IDs in \@sourceids into
2925 the invoice identified by $invoiceid.
2930 my ($invoiceid, $sourceids) = @_;
2932 return unless $invoiceid;
2933 foreach my $sourceid (@$sourceids) {
2934 next if $sourceid == $invoiceid;
2935 my $source = GetInvoiceDetails($sourceid);
2936 foreach my $order (@{$source->{'orders'}}) {
2937 $order->{'invoiceid'} = $invoiceid;
2940 DelInvoice($source->{'invoiceid'});
2945 =head3 GetBiblioCountByBasketno
2947 $biblio_count = &GetBiblioCountByBasketno($basketno);
2949 Looks up the biblio's count that has basketno value $basketno
2955 sub GetBiblioCountByBasketno {
2956 my ($basketno) = @_;
2957 my $dbh = C4::Context->dbh;
2959 SELECT COUNT( DISTINCT( biblionumber ) )
2962 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
2965 my $sth = $dbh->prepare($query);
2966 $sth->execute($basketno);
2967 return $sth->fetchrow;
2970 # Note this subroutine should be moved to Koha::Acquisition::Order
2971 # Will do when a DBIC decision will be taken.
2972 sub populate_order_with_prices {
2975 my $order = $params->{order};
2976 my $booksellerid = $params->{booksellerid};
2977 return unless $booksellerid;
2979 my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
2981 my $receiving = $params->{receiving};
2982 my $ordering = $params->{ordering};
2983 my $discount = $order->{discount};
2984 $discount /= 100 if $discount > 1;
2987 $order->{tax_rate_on_ordering} //= $order->{tax_rate};
2988 if ( $bookseller->listincgst ) {
2989 # The user entered the rrp tax included
2990 $order->{rrp_tax_included} = $order->{rrp};
2992 # rrp tax excluded = rrp tax included / ( 1 + tax rate )
2993 $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2995 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2996 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2998 # ecost tax included = rrp tax included ( 1 - discount )
2999 $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
3002 # The user entered the rrp tax excluded
3003 $order->{rrp_tax_excluded} = $order->{rrp};
3005 # rrp tax included = rrp tax excluded * ( 1 - tax rate )
3006 $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
3008 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
3009 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
3011 # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount )
3012 $order->{ecost_tax_included} =
3013 $order->{rrp_tax_excluded} *
3014 ( 1 + $order->{tax_rate_on_ordering} ) *
3018 # tax value = quantity * ecost tax excluded * tax rate
3019 $order->{tax_value_on_ordering} =
3020 $order->{quantity} * $order->{ecost_tax_excluded} * $order->{tax_rate_on_ordering};
3024 $order->{tax_rate_on_receiving} //= $order->{tax_rate};
3025 if ( $bookseller->invoiceincgst ) {
3026 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3027 # we need to keep the exact ecost value
3028 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
3029 $order->{unitprice} = $order->{ecost_tax_included};
3032 # The user entered the unit price tax included
3033 $order->{unitprice_tax_included} = $order->{unitprice};
3035 # unit price tax excluded = unit price tax included / ( 1 + tax rate )
3036 $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
3039 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3040 # we need to keep the exact ecost value
3041 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
3042 $order->{unitprice} = $order->{ecost_tax_excluded};
3045 # The user entered the unit price tax excluded
3046 $order->{unitprice_tax_excluded} = $order->{unitprice};
3049 # unit price tax included = unit price tax included * ( 1 + tax rate )
3050 $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
3053 # tax value = quantity * unit price tax excluded * tax rate
3054 $order->{tax_value_on_receiving} = $order->{quantity} * $order->{unitprice_tax_excluded} * $order->{tax_rate_on_receiving};
3060 =head3 GetOrderUsers
3062 $order_users_ids = &GetOrderUsers($ordernumber);
3064 Returns a list of all borrowernumbers that are in order users list
3069 my ($ordernumber) = @_;
3071 return unless $ordernumber;
3074 SELECT borrowernumber
3076 WHERE ordernumber = ?
3078 my $dbh = C4::Context->dbh;
3079 my $sth = $dbh->prepare($query);
3080 $sth->execute($ordernumber);
3081 my $results = $sth->fetchall_arrayref( {} );
3083 my @borrowernumbers;
3084 foreach (@$results) {
3085 push @borrowernumbers, $_->{'borrowernumber'};
3088 return @borrowernumbers;
3091 =head3 ModOrderUsers
3093 my @order_users_ids = (1, 2, 3);
3094 &ModOrderUsers($ordernumber, @basketusers_ids);
3096 Delete all users from order users list, and add users in C<@order_users_ids>
3102 my ( $ordernumber, @order_users_ids ) = @_;
3104 return unless $ordernumber;
3106 my $dbh = C4::Context->dbh;
3108 DELETE FROM aqorder_users
3109 WHERE ordernumber = ?
3111 my $sth = $dbh->prepare($query);
3112 $sth->execute($ordernumber);
3115 INSERT INTO aqorder_users (ordernumber, borrowernumber)
3118 $sth = $dbh->prepare($query);
3119 foreach my $order_user_id (@order_users_ids) {
3120 $sth->execute( $ordernumber, $order_user_id );
3124 sub NotifyOrderUsers {
3125 my ($ordernumber) = @_;
3127 my @borrowernumbers = GetOrderUsers($ordernumber);
3128 return unless @borrowernumbers;
3130 my $order = GetOrder( $ordernumber );
3131 for my $borrowernumber (@borrowernumbers) {
3132 my $patron = Koha::Patrons->find( $borrowernumber );
3133 my $library = $patron->library->unblessed;
3134 my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed;
3135 my $letter = C4::Letters::GetPreparedLetter(
3136 module => 'acquisition',
3137 letter_code => 'ACQ_NOTIF_ON_RECEIV',
3138 branchcode => $library->{branchcode},
3139 lang => $patron->lang,
3141 'branches' => $library,
3142 'borrowers' => $patron->unblessed,
3143 'biblio' => $biblio,
3144 'aqorders' => $order,
3148 C4::Letters::EnqueueLetter(
3151 borrowernumber => $borrowernumber,
3152 LibraryName => C4::Context->preference("LibraryName"),
3153 message_transport_type => 'email',
3155 ) or warn "can't enqueue letter $letter";
3160 =head3 FillWithDefaultValues
3162 FillWithDefaultValues( $marc_record );
3164 This will update the record with default value defined in the ACQ framework.
3165 For all existing fields, if a default value exists and there are no subfield, it will be created.
3166 If the field does not exist, it will be created too.
3170 sub FillWithDefaultValues {
3172 my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3175 C4::Biblio::GetMarcFromKohaField( 'items.itemnumber', '' );
3176 for my $tag ( sort keys %$tagslib ) {
3178 next if $tag == $itemfield;
3179 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3180 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3181 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3182 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3183 my @fields = $record->field($tag);
3185 for my $field (@fields) {
3186 unless ( defined $field->subfield($subfield) ) {
3187 $field->add_subfields(
3188 $subfield => $defaultvalue );
3193 $record->insert_fields_ordered(
3195 $tag, '', '', $subfield => $defaultvalue
3210 Koha Development Team <http://koha-community.org/>