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 , unitprice = ?, unitprice_tax_included = ?, unitprice_tax_excluded = ?
1521 | if defined $order->{unitprice};
1524 ,tax_value_on_receiving = ?
1525 | if defined $order->{tax_value_on_receiving};
1528 ,tax_rate_on_receiving = ?
1529 | if defined $order->{tax_rate_on_receiving};
1532 , order_internalnote = ?
1533 | if defined $order->{order_internalnote};
1535 $query .= q| where biblionumber=? and ordernumber=?|;
1537 my $sth = $dbh->prepare( $query );
1538 my @params = ( $quantrec, $datereceived, $invoice->{invoiceid}, ( $budget_id ? $budget_id : $order->{budget_id} ) );
1540 if ( defined $order->{unitprice} ) {
1541 push @params, $order->{unitprice}, $order->{unitprice_tax_included}, $order->{unitprice_tax_excluded};
1544 if ( defined $order->{tax_value_on_receiving} ) {
1545 push @params, $order->{tax_value_on_receiving};
1548 if ( defined $order->{tax_rate_on_receiving} ) {
1549 push @params, $order->{tax_rate_on_receiving};
1552 if ( defined $order->{order_internalnote} ) {
1553 push @params, $order->{order_internalnote};
1556 push @params, ( $biblionumber, $order->{ordernumber} );
1558 $sth->execute( @params );
1560 # All items have been received, sent a notification to users
1561 NotifyOrderUsers( $order->{ordernumber} );
1564 return ($datereceived, $new_ordernumber);
1567 =head3 CancelReceipt
1569 my $parent_ordernumber = CancelReceipt($ordernumber);
1571 Cancel an order line receipt and update the parent order line, as if no
1573 If items are created at receipt (AcqCreateItem = receiving) then delete
1579 my $ordernumber = shift;
1581 return unless $ordernumber;
1583 my $dbh = C4::Context->dbh;
1585 SELECT datereceived, parent_ordernumber, quantity
1587 WHERE ordernumber = ?
1589 my $sth = $dbh->prepare($query);
1590 $sth->execute($ordernumber);
1591 my $order = $sth->fetchrow_hashref;
1593 warn "CancelReceipt: order $ordernumber does not exist";
1596 unless($order->{'datereceived'}) {
1597 warn "CancelReceipt: order $ordernumber is not received";
1601 my $parent_ordernumber = $order->{'parent_ordernumber'};
1603 my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1604 my $order_obj = Koha::Acquisition::Orders->find( $ordernumber ); # FIXME rewrite all this subroutine using this object
1606 if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1607 # The order line has no parent, just mark it as not received
1610 SET quantityreceived = ?,
1613 orderstatus = 'ordered'
1614 WHERE ordernumber = ?
1616 $sth = $dbh->prepare($query);
1617 $sth->execute(0, undef, undef, $ordernumber);
1618 _cancel_items_receipt( $order_obj );
1620 # The order line has a parent, increase parent quantity and delete
1623 SELECT quantity, datereceived
1625 WHERE ordernumber = ?
1627 $sth = $dbh->prepare($query);
1628 $sth->execute($parent_ordernumber);
1629 my $parent_order = $sth->fetchrow_hashref;
1630 unless($parent_order) {
1631 warn "Parent order $parent_ordernumber does not exist.";
1634 if($parent_order->{'datereceived'}) {
1635 warn "CancelReceipt: parent order is received.".
1636 " Can't cancel receipt.";
1642 orderstatus = 'ordered'
1643 WHERE ordernumber = ?
1645 $sth = $dbh->prepare($query);
1646 my $rv = $sth->execute(
1647 $order->{'quantity'} + $parent_order->{'quantity'},
1651 warn "Cannot update parent order line, so do not cancel".
1656 # Recalculate tax_value
1660 tax_value_on_ordering = quantity * ecost_tax_excluded * tax_rate_on_ordering,
1661 tax_value_on_receiving = quantity * unitprice_tax_excluded * tax_rate_on_receiving
1662 WHERE ordernumber = ?
1663 |, undef, $parent_ordernumber);
1665 _cancel_items_receipt( $order_obj, $parent_ordernumber );
1668 DELETE FROM aqorders
1669 WHERE ordernumber = ?
1671 $sth = $dbh->prepare($query);
1672 $sth->execute($ordernumber);
1676 if( $order_obj->basket->effective_create_items eq 'ordering' ) {
1677 my @affects = split q{\|}, C4::Context->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1679 for my $in ( @itemnumbers ) {
1680 my $item = Koha::Items->find( $in );
1681 my $biblio = $item->biblio;
1682 my ( $itemfield ) = GetMarcFromKohaField( 'items.itemnumber', $biblio->frameworkcode );
1683 my $item_marc = C4::Items::GetMarcItem( $biblio->biblionumber, $in );
1684 for my $affect ( @affects ) {
1685 my ( $sf, $v ) = split q{=}, $affect, 2;
1686 foreach ( $item_marc->field($itemfield) ) {
1687 $_->update( $sf => $v );
1690 C4::Items::ModItemFromMarc( $item_marc, $biblio->biblionumber, $in );
1695 return $parent_ordernumber;
1698 sub _cancel_items_receipt {
1699 my ( $order, $parent_ordernumber ) = @_;
1700 $parent_ordernumber ||= $order->ordernumber;
1702 my @itemnumbers = GetItemnumbersFromOrder($order->ordernumber); # FIXME Must be $order->items
1703 if ( $order->basket->effective_create_items eq 'receiving' ) {
1704 # Remove items that were created at receipt
1706 DELETE FROM items, aqorders_items
1707 USING items, aqorders_items
1708 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1710 my $dbh = C4::Context->dbh;
1711 my $sth = $dbh->prepare($query);
1712 foreach my $itemnumber (@itemnumbers) {
1713 $sth->execute($itemnumber, $itemnumber);
1717 foreach my $itemnumber (@itemnumbers) {
1718 ModItemOrder($itemnumber, $parent_ordernumber);
1723 #------------------------------------------------------------#
1727 @results = &SearchOrders({
1728 ordernumber => $ordernumber,
1731 booksellerid => $booksellerid,
1732 basketno => $basketno,
1733 basketname => $basketname,
1734 basketgroupname => $basketgroupname,
1738 biblionumber => $biblionumber,
1739 budget_id => $budget_id
1742 Searches for orders filtered by criteria.
1744 C<$ordernumber> Finds matching orders or transferred orders by ordernumber.
1745 C<$search> Finds orders matching %$search% in title, author, or isbn.
1746 C<$owner> Finds order for the logged in user.
1747 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1748 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1751 C<@results> is an array of references-to-hash with the keys are fields
1752 from aqorders, biblio, biblioitems and aqbasket tables.
1757 my ( $params ) = @_;
1758 my $ordernumber = $params->{ordernumber};
1759 my $search = $params->{search};
1760 my $ean = $params->{ean};
1761 my $booksellerid = $params->{booksellerid};
1762 my $basketno = $params->{basketno};
1763 my $basketname = $params->{basketname};
1764 my $basketgroupname = $params->{basketgroupname};
1765 my $owner = $params->{owner};
1766 my $pending = $params->{pending};
1767 my $ordered = $params->{ordered};
1768 my $biblionumber = $params->{biblionumber};
1769 my $budget_id = $params->{budget_id};
1771 my $dbh = C4::Context->dbh;
1774 SELECT aqbasket.basketno,
1776 borrowers.firstname,
1779 biblioitems.biblioitemnumber,
1780 biblioitems.publishercode,
1781 biblioitems.publicationyear,
1782 aqbasket.authorisedby,
1783 aqbasket.booksellerid,
1785 aqbasket.creationdate,
1786 aqbasket.basketname,
1787 aqbasketgroups.id as basketgroupid,
1788 aqbasketgroups.name as basketgroupname,
1791 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1792 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1793 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1794 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1795 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1798 # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
1800 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1804 WHERE (datecancellationprinted is NULL)
1807 if ( $pending or $ordered ) {
1810 ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) )
1812 ( quantity > quantityreceived OR quantityreceived is NULL )
1816 $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1824 my $userenv = C4::Context->userenv;
1825 if ( C4::Context->preference("IndependentBranches") ) {
1826 unless ( C4::Context->IsSuperLibrarian() ) {
1829 borrowers.branchcode = ?
1830 OR borrowers.branchcode = ''
1833 push @args, $userenv->{branch};
1837 if ( $ordernumber ) {
1838 $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1839 push @args, ( $ordernumber, $ordernumber );
1841 if ( $biblionumber ) {
1842 $query .= 'AND aqorders.biblionumber = ?';
1843 push @args, $biblionumber;
1846 $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1847 push @args, ("%$search%","%$search%","%$search%");
1850 $query .= ' AND biblioitems.ean = ?';
1853 if ( $booksellerid ) {
1854 $query .= 'AND aqbasket.booksellerid = ?';
1855 push @args, $booksellerid;
1858 $query .= 'AND aqbasket.basketno = ?';
1859 push @args, $basketno;
1862 $query .= 'AND aqbasket.basketname LIKE ?';
1863 push @args, "%$basketname%";
1865 if( $basketgroupname ) {
1866 $query .= ' AND aqbasketgroups.name LIKE ?';
1867 push @args, "%$basketgroupname%";
1871 $query .= ' AND aqbasket.authorisedby=? ';
1872 push @args, $userenv->{'number'};
1876 $query .= ' AND aqorders.budget_id = ?';
1877 push @args, $budget_id;
1880 $query .= ' ORDER BY aqbasket.basketno';
1882 my $sth = $dbh->prepare($query);
1883 $sth->execute(@args);
1884 return $sth->fetchall_arrayref({});
1887 #------------------------------------------------------------#
1891 &DelOrder($biblionumber, $ordernumber);
1893 Cancel the order with the given order and biblio numbers. It does not
1894 delete any entries in the aqorders table, it merely marks them as
1900 my ( $bibnum, $ordernumber, $delete_biblio, $reason ) = @_;
1903 my $dbh = C4::Context->dbh;
1906 SET datecancellationprinted=now(), orderstatus='cancelled'
1909 $query .= ", cancellationreason = ? ";
1912 WHERE biblionumber=? AND ordernumber=?
1914 my $sth = $dbh->prepare($query);
1916 $sth->execute($reason, $bibnum, $ordernumber);
1918 $sth->execute( $bibnum, $ordernumber );
1922 my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1923 foreach my $itemnumber (@itemnumbers){
1924 my $delcheck = C4::Items::DelItemCheck( $bibnum, $itemnumber );
1926 if($delcheck != 1) {
1927 $error->{'delitem'} = 1;
1931 if($delete_biblio) {
1932 # We get the number of remaining items
1933 my $biblio = Koha::Biblios->find( $bibnum );
1934 my $itemcount = $biblio->items->count;
1936 # If there are no items left,
1937 if ( $itemcount == 0 ) {
1938 # We delete the record
1939 my $delcheck = DelBiblio($bibnum);
1942 $error->{'delbiblio'} = 1;
1950 =head3 TransferOrder
1952 my $newordernumber = TransferOrder($ordernumber, $basketno);
1954 Transfer an order line to a basket.
1955 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1956 to BOOKSELLER on DATE' and create new order with internal note
1957 'Transferred from BOOKSELLER on DATE'.
1958 Move all attached items to the new order.
1959 Received orders cannot be transferred.
1960 Return the ordernumber of created order.
1965 my ($ordernumber, $basketno) = @_;
1967 return unless ($ordernumber and $basketno);
1969 my $order = Koha::Acquisition::Orders->find( $ordernumber ) or return;
1970 return if $order->datereceived;
1972 $order = $order->unblessed;
1974 my $basket = GetBasket($basketno);
1975 return unless $basket;
1977 my $dbh = C4::Context->dbh;
1978 my ($query, $sth, $rv);
1982 SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1983 WHERE ordernumber = ?
1985 $sth = $dbh->prepare($query);
1986 $rv = $sth->execute('cancelled', $ordernumber);
1988 delete $order->{'ordernumber'};
1989 delete $order->{parent_ordernumber};
1990 $order->{'basketno'} = $basketno;
1992 my $newordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber;
1995 UPDATE aqorders_items
1997 WHERE ordernumber = ?
1999 $sth = $dbh->prepare($query);
2000 $sth->execute($newordernumber, $ordernumber);
2003 INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
2006 $sth = $dbh->prepare($query);
2007 $sth->execute($ordernumber, $newordernumber);
2009 return $newordernumber;
2012 =head2 FUNCTIONS ABOUT PARCELS
2016 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
2018 get a lists of parcels.
2025 is the bookseller this function has to get parcels.
2028 To know on what criteria the results list has to be ordered.
2031 is the booksellerinvoicenumber.
2033 =item $datefrom & $dateto
2034 to know on what date this function has to filter its search.
2039 a pointer on a hash list containing parcel informations as such :
2045 =item Last operation
2047 =item Number of biblio
2049 =item Number of items
2056 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
2057 my $dbh = C4::Context->dbh;
2058 my @query_params = ();
2060 SELECT aqinvoices.invoicenumber,
2061 datereceived,purchaseordernumber,
2062 count(DISTINCT biblionumber) AS biblio,
2063 sum(quantity) AS itemsexpected,
2064 sum(quantityreceived) AS itemsreceived
2065 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
2066 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2067 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
2069 push @query_params, $bookseller;
2071 if ( defined $code ) {
2072 $strsth .= ' and aqinvoices.invoicenumber like ? ';
2073 # add a % to the end of the code to allow stemming.
2074 push @query_params, "$code%";
2077 if ( defined $datefrom ) {
2078 $strsth .= ' and datereceived >= ? ';
2079 push @query_params, $datefrom;
2082 if ( defined $dateto ) {
2083 $strsth .= 'and datereceived <= ? ';
2084 push @query_params, $dateto;
2087 $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
2089 # can't use a placeholder to place this column name.
2090 # but, we could probably be checking to make sure it is a column that will be fetched.
2091 $strsth .= "order by $order " if ($order);
2093 my $sth = $dbh->prepare($strsth);
2095 $sth->execute( @query_params );
2096 my $results = $sth->fetchall_arrayref({});
2100 #------------------------------------------------------------#
2102 =head3 GetLateOrders
2104 @results = &GetLateOrders;
2106 Searches for bookseller with late orders.
2109 the table of supplier with late issues. This table is full of hashref.
2115 my $supplierid = shift;
2117 my $estimateddeliverydatefrom = shift;
2118 my $estimateddeliverydateto = shift;
2120 my $dbh = C4::Context->dbh;
2122 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
2123 my $dbdriver = C4::Context->config("db_scheme") || "mysql";
2125 my @query_params = ();
2127 SELECT aqbasket.basketno,
2128 aqorders.ordernumber,
2129 DATE(aqbasket.closedate) AS orderdate,
2130 aqbasket.basketname AS basketname,
2131 aqbasket.basketgroupid AS basketgroupid,
2132 aqbasketgroups.name AS basketgroupname,
2133 aqorders.rrp AS unitpricesupplier,
2134 aqorders.ecost AS unitpricelib,
2135 aqorders.claims_count AS claims_count,
2136 aqorders.claimed_date AS claimed_date,
2137 aqbudgets.budget_name AS budget,
2138 borrowers.branchcode AS branch,
2139 aqbooksellers.name AS supplier,
2140 aqbooksellers.id AS supplierid,
2141 biblio.author, biblio.title,
2142 biblioitems.publishercode AS publisher,
2143 biblioitems.publicationyear,
2144 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
2148 aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
2149 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
2150 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
2151 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
2152 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
2153 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2154 WHERE aqorders.basketno = aqbasket.basketno
2155 AND ( datereceived = ''
2156 OR datereceived IS NULL
2157 OR aqorders.quantityreceived < aqorders.quantity
2159 AND aqbasket.closedate IS NOT NULL
2160 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
2162 if ($dbdriver eq "mysql") {
2164 aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity,
2165 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
2166 DATEDIFF(CAST(now() AS date),closedate) AS latesince
2168 if ( defined $delay ) {
2169 $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
2170 push @query_params, $delay;
2172 $from .= " AND aqorders.quantity - COALESCE(aqorders.quantityreceived,0) <> 0";
2174 # FIXME: account for IFNULL as above
2176 aqorders.quantity AS quantity,
2177 aqorders.quantity * aqorders.rrp AS subtotal,
2178 (CAST(now() AS date) - closedate) AS latesince
2180 if ( defined $delay ) {
2181 $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
2182 push @query_params, $delay;
2184 $from .= " AND aqorders.quantity <> 0";
2186 if (defined $supplierid) {
2187 $from .= ' AND aqbasket.booksellerid = ? ';
2188 push @query_params, $supplierid;
2190 if (defined $branch) {
2191 $from .= ' AND borrowers.branchcode LIKE ? ';
2192 push @query_params, $branch;
2195 if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
2196 $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
2198 if ( defined $estimateddeliverydatefrom ) {
2199 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
2200 push @query_params, $estimateddeliverydatefrom;
2202 if ( defined $estimateddeliverydateto ) {
2203 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
2204 push @query_params, $estimateddeliverydateto;
2206 if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
2207 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
2209 if (C4::Context->preference("IndependentBranches")
2210 && !C4::Context->IsSuperLibrarian() ) {
2211 $from .= ' AND borrowers.branchcode LIKE ? ';
2212 push @query_params, C4::Context->userenv->{branch};
2214 $from .= " AND orderstatus <> 'cancelled' ";
2215 my $query = "$select $from \nORDER BY latesince, basketno, borrowers.branchcode, supplier";
2216 $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
2217 my $sth = $dbh->prepare($query);
2218 $sth->execute(@query_params);
2220 while (my $data = $sth->fetchrow_hashref) {
2221 push @results, $data;
2226 #------------------------------------------------------------#
2230 \@order_loop = GetHistory( %params );
2232 Retreives some acquisition history information
2242 basket - search both basket name and number
2243 booksellerinvoicenumber
2246 orderstatus (note that orderstatus '' will retrieve orders
2247 of any status except cancelled)
2249 get_canceled_order (if set to a true value, cancelled orders will
2253 $order_loop is a list of hashrefs that each look like this:
2255 'author' => 'Twain, Mark',
2257 'biblionumber' => '215',
2259 'creationdate' => 'MM/DD/YYYY',
2260 'datereceived' => undef,
2263 'invoicenumber' => undef,
2265 'ordernumber' => '1',
2267 'quantityreceived' => undef,
2268 'title' => 'The Adventures of Huckleberry Finn'
2274 # don't run the query if there are no parameters (list would be too long for sure !)
2275 croak "No search params" unless @_;
2277 my $title = $params{title};
2278 my $author = $params{author};
2279 my $isbn = $params{isbn};
2280 my $ean = $params{ean};
2281 my $name = $params{name};
2282 my $from_placed_on = $params{from_placed_on};
2283 my $to_placed_on = $params{to_placed_on};
2284 my $basket = $params{basket};
2285 my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2286 my $basketgroupname = $params{basketgroupname};
2287 my $budget = $params{budget};
2288 my $orderstatus = $params{orderstatus};
2289 my $biblionumber = $params{biblionumber};
2290 my $get_canceled_order = $params{get_canceled_order} || 0;
2291 my $ordernumber = $params{ordernumber};
2292 my $search_children_too = $params{search_children_too} || 0;
2293 my $created_by = $params{created_by} || [];
2297 my $total_qtyreceived = 0;
2298 my $total_price = 0;
2300 #get variation of isbn
2304 if ( C4::Context->preference("SearchWithISBNVariations") ){
2305 @isbns = C4::Koha::GetVariationsOfISBN( $isbn );
2306 foreach my $isb (@isbns){
2307 push @isbn_params, '?';
2312 push @isbn_params, '?';
2316 my $dbh = C4::Context->dbh;
2319 COALESCE(biblio.title, deletedbiblio.title) AS title,
2320 COALESCE(biblio.author, deletedbiblio.author) AS author,
2321 COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2322 COALESCE(biblioitems.ean, deletedbiblioitems.ean) AS ean,
2324 aqbasket.basketname,
2325 aqbasket.basketgroupid,
2326 aqbasket.authorisedby,
2327 concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2328 aqbasketgroups.name as groupname,
2330 aqbasket.creationdate,
2331 aqorders.datereceived,
2333 aqorders.quantityreceived,
2335 aqorders.ordernumber,
2337 aqinvoices.invoicenumber,
2338 aqbooksellers.id as id,
2339 aqorders.biblionumber,
2340 aqorders.orderstatus,
2341 aqorders.parent_ordernumber,
2342 aqbudgets.budget_name
2344 $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2347 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2348 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2349 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2350 LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2351 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2352 LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2353 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2354 LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2355 LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2356 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2359 $query .= " WHERE 1 ";
2361 unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2362 $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2365 my @query_params = ();
2367 if ( $biblionumber ) {
2368 $query .= " AND biblio.biblionumber = ?";
2369 push @query_params, $biblionumber;
2373 $query .= " AND biblio.title LIKE ? ";
2374 $title =~ s/\s+/%/g;
2375 push @query_params, "%$title%";
2379 $query .= " AND biblio.author LIKE ? ";
2380 push @query_params, "%$author%";
2384 $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2385 foreach my $isb (@isbns){
2386 push @query_params, "%$isb%";
2391 $query .= " AND biblioitems.ean = ? ";
2392 push @query_params, "$ean";
2395 $query .= " AND aqbooksellers.name LIKE ? ";
2396 push @query_params, "%$name%";
2400 $query .= " AND aqbudgets.budget_id = ? ";
2401 push @query_params, "$budget";
2404 if ( $from_placed_on ) {
2405 $query .= " AND creationdate >= ? ";
2406 push @query_params, $from_placed_on;
2409 if ( $to_placed_on ) {
2410 $query .= " AND creationdate <= ? ";
2411 push @query_params, $to_placed_on;
2414 if ( defined $orderstatus and $orderstatus ne '') {
2415 $query .= " AND aqorders.orderstatus = ? ";
2416 push @query_params, "$orderstatus";
2420 if ($basket =~ m/^\d+$/) {
2421 $query .= " AND aqorders.basketno = ? ";
2422 push @query_params, $basket;
2424 $query .= " AND aqbasket.basketname LIKE ? ";
2425 push @query_params, "%$basket%";
2429 if ($booksellerinvoicenumber) {
2430 $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2431 push @query_params, "%$booksellerinvoicenumber%";
2434 if ($basketgroupname) {
2435 $query .= " AND aqbasketgroups.name LIKE ? ";
2436 push @query_params, "%$basketgroupname%";
2440 $query .= " AND (aqorders.ordernumber = ? ";
2441 push @query_params, $ordernumber;
2442 if ($search_children_too) {
2443 $query .= " OR aqorders.parent_ordernumber = ? ";
2444 push @query_params, $ordernumber;
2449 if ( @$created_by ) {
2450 $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2451 push @query_params, @$created_by;
2455 if ( C4::Context->preference("IndependentBranches") ) {
2456 unless ( C4::Context->IsSuperLibrarian() ) {
2457 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2458 push @query_params, C4::Context->userenv->{branch};
2461 $query .= " ORDER BY id";
2463 return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2466 =head2 GetRecentAcqui
2468 $results = GetRecentAcqui($days);
2470 C<$results> is a ref to a table which contains hashref
2474 sub GetRecentAcqui {
2476 my $dbh = C4::Context->dbh;
2480 ORDER BY timestamp DESC
2483 my $sth = $dbh->prepare($query);
2485 my $results = $sth->fetchall_arrayref({});
2489 #------------------------------------------------------------#
2493 &AddClaim($ordernumber);
2495 Add a claim for an order
2500 my ($ordernumber) = @_;
2501 my $dbh = C4::Context->dbh;
2504 claims_count = claims_count + 1,
2505 claimed_date = CURDATE()
2506 WHERE ordernumber = ?
2508 my $sth = $dbh->prepare($query);
2509 $sth->execute($ordernumber);
2514 my @invoices = GetInvoices(
2515 invoicenumber => $invoicenumber,
2516 supplierid => $supplierid,
2517 suppliername => $suppliername,
2518 shipmentdatefrom => $shipmentdatefrom, # ISO format
2519 shipmentdateto => $shipmentdateto, # ISO format
2520 billingdatefrom => $billingdatefrom, # ISO format
2521 billingdateto => $billingdateto, # ISO format
2522 isbneanissn => $isbn_or_ean_or_issn,
2525 publisher => $publisher,
2526 publicationyear => $publicationyear,
2527 branchcode => $branchcode,
2528 order_by => $order_by
2531 Return a list of invoices that match all given criteria.
2533 $order_by is "column_name (asc|desc)", where column_name is any of
2534 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2535 'shipmentcost', 'shipmentcost_budgetid'.
2537 asc is the default if omitted
2544 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2545 closedate shipmentcost shipmentcost_budgetid);
2547 my $dbh = C4::Context->dbh;
2549 SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
2550 aqbooksellers.name AS suppliername,
2553 aqorders.datereceived IS NOT NULL,
2554 aqorders.biblionumber,
2557 ) AS receivedbiblios,
2560 aqorders.subscriptionid IS NOT NULL,
2561 aqorders.subscriptionid,
2564 ) AS is_linked_to_subscriptions,
2565 SUM(aqorders.quantityreceived) AS receiveditems
2567 LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2568 LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2569 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2570 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2571 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2572 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2573 LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2578 if($args{supplierid}) {
2579 push @bind_strs, " aqinvoices.booksellerid = ? ";
2580 push @bind_args, $args{supplierid};
2582 if($args{invoicenumber}) {
2583 push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2584 push @bind_args, "%$args{invoicenumber}%";
2586 if($args{suppliername}) {
2587 push @bind_strs, " aqbooksellers.name LIKE ? ";
2588 push @bind_args, "%$args{suppliername}%";
2590 if($args{shipmentdatefrom}) {
2591 push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2592 push @bind_args, $args{shipmentdatefrom};
2594 if($args{shipmentdateto}) {
2595 push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2596 push @bind_args, $args{shipmentdateto};
2598 if($args{billingdatefrom}) {
2599 push @bind_strs, " aqinvoices.billingdate >= ? ";
2600 push @bind_args, $args{billingdatefrom};
2602 if($args{billingdateto}) {
2603 push @bind_strs, " aqinvoices.billingdate <= ? ";
2604 push @bind_args, $args{billingdateto};
2606 if($args{isbneanissn}) {
2607 push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2608 push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2611 push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2612 push @bind_args, $args{title};
2615 push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2616 push @bind_args, $args{author};
2618 if($args{publisher}) {
2619 push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2620 push @bind_args, $args{publisher};
2622 if($args{publicationyear}) {
2623 push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2624 push @bind_args, $args{publicationyear}, $args{publicationyear};
2626 if($args{branchcode}) {
2627 push @bind_strs, " borrowers.branchcode = ? ";
2628 push @bind_args, $args{branchcode};
2630 if($args{message_id}) {
2631 push @bind_strs, " aqinvoices.message_id = ? ";
2632 push @bind_args, $args{message_id};
2635 $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2636 $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";
2638 if($args{order_by}) {
2639 my ($column, $direction) = split / /, $args{order_by};
2640 if(grep /^$column$/, @columns) {
2641 $direction ||= 'ASC';
2642 $query .= " ORDER BY $column $direction";
2646 my $sth = $dbh->prepare($query);
2647 $sth->execute(@bind_args);
2649 my $results = $sth->fetchall_arrayref({});
2655 my $invoice = GetInvoice($invoiceid);
2657 Get informations about invoice with given $invoiceid
2659 Return a hash filled with aqinvoices.* fields
2664 my ($invoiceid) = @_;
2667 return unless $invoiceid;
2669 my $dbh = C4::Context->dbh;
2675 my $sth = $dbh->prepare($query);
2676 $sth->execute($invoiceid);
2678 $invoice = $sth->fetchrow_hashref;
2682 =head3 GetInvoiceDetails
2684 my $invoice = GetInvoiceDetails($invoiceid)
2686 Return informations about an invoice + the list of related order lines
2688 Orders informations are in $invoice->{orders} (array ref)
2692 sub GetInvoiceDetails {
2693 my ($invoiceid) = @_;
2695 if ( !defined $invoiceid ) {
2696 carp 'GetInvoiceDetails called without an invoiceid';
2700 my $dbh = C4::Context->dbh;
2702 SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2704 LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2707 my $sth = $dbh->prepare($query);
2708 $sth->execute($invoiceid);
2710 my $invoice = $sth->fetchrow_hashref;
2715 biblio.copyrightdate,
2717 biblioitems.publishercode,
2718 biblioitems.publicationyear,
2719 aqbasket.basketname,
2720 aqbasketgroups.id AS basketgroupid,
2721 aqbasketgroups.name AS basketgroupname
2723 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2724 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2725 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2726 LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2729 $sth = $dbh->prepare($query);
2730 $sth->execute($invoiceid);
2731 $invoice->{orders} = $sth->fetchall_arrayref({});
2732 $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2739 my $invoiceid = AddInvoice(
2740 invoicenumber => $invoicenumber,
2741 booksellerid => $booksellerid,
2742 shipmentdate => $shipmentdate,
2743 billingdate => $billingdate,
2744 closedate => $closedate,
2745 shipmentcost => $shipmentcost,
2746 shipmentcost_budgetid => $shipmentcost_budgetid
2749 Create a new invoice and return its id or undef if it fails.
2756 return unless(%invoice and $invoice{invoicenumber});
2758 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2759 closedate shipmentcost shipmentcost_budgetid message_id);
2763 foreach my $key (keys %invoice) {
2764 if(0 < grep(/^$key$/, @columns)) {
2765 push @set_strs, "$key = ?";
2766 push @set_args, ($invoice{$key} || undef);
2772 my $dbh = C4::Context->dbh;
2773 my $query = "INSERT INTO aqinvoices SET ";
2774 $query .= join (",", @set_strs);
2775 my $sth = $dbh->prepare($query);
2776 $rv = $sth->execute(@set_args);
2778 $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2787 invoiceid => $invoiceid, # Mandatory
2788 invoicenumber => $invoicenumber,
2789 booksellerid => $booksellerid,
2790 shipmentdate => $shipmentdate,
2791 billingdate => $billingdate,
2792 closedate => $closedate,
2793 shipmentcost => $shipmentcost,
2794 shipmentcost_budgetid => $shipmentcost_budgetid
2797 Modify an invoice, invoiceid is mandatory.
2799 Return undef if it fails.
2806 return unless(%invoice and $invoice{invoiceid});
2808 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2809 closedate shipmentcost shipmentcost_budgetid);
2813 foreach my $key (keys %invoice) {
2814 if(0 < grep(/^$key$/, @columns)) {
2815 push @set_strs, "$key = ?";
2816 push @set_args, ($invoice{$key} || undef);
2820 my $dbh = C4::Context->dbh;
2821 my $query = "UPDATE aqinvoices SET ";
2822 $query .= join(",", @set_strs);
2823 $query .= " WHERE invoiceid = ?";
2825 my $sth = $dbh->prepare($query);
2826 $sth->execute(@set_args, $invoice{invoiceid});
2831 CloseInvoice($invoiceid);
2835 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2840 my ($invoiceid) = @_;
2842 return unless $invoiceid;
2844 my $dbh = C4::Context->dbh;
2847 SET closedate = CAST(NOW() AS DATE)
2850 my $sth = $dbh->prepare($query);
2851 $sth->execute($invoiceid);
2854 =head3 ReopenInvoice
2856 ReopenInvoice($invoiceid);
2860 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2865 my ($invoiceid) = @_;
2867 return unless $invoiceid;
2869 my $dbh = C4::Context->dbh;
2872 SET closedate = NULL
2875 my $sth = $dbh->prepare($query);
2876 $sth->execute($invoiceid);
2881 DelInvoice($invoiceid);
2883 Delete an invoice if there are no items attached to it.
2888 my ($invoiceid) = @_;
2890 return unless $invoiceid;
2892 my $dbh = C4::Context->dbh;
2898 my $sth = $dbh->prepare($query);
2899 $sth->execute($invoiceid);
2900 my $res = $sth->fetchrow_arrayref;
2901 if ( $res && $res->[0] == 0 ) {
2903 DELETE FROM aqinvoices
2906 my $sth = $dbh->prepare($query);
2907 return ( $sth->execute($invoiceid) > 0 );
2912 =head3 MergeInvoices
2914 MergeInvoices($invoiceid, \@sourceids);
2916 Merge the invoices identified by the IDs in \@sourceids into
2917 the invoice identified by $invoiceid.
2922 my ($invoiceid, $sourceids) = @_;
2924 return unless $invoiceid;
2925 foreach my $sourceid (@$sourceids) {
2926 next if $sourceid == $invoiceid;
2927 my $source = GetInvoiceDetails($sourceid);
2928 foreach my $order (@{$source->{'orders'}}) {
2929 $order->{'invoiceid'} = $invoiceid;
2932 DelInvoice($source->{'invoiceid'});
2937 =head3 GetBiblioCountByBasketno
2939 $biblio_count = &GetBiblioCountByBasketno($basketno);
2941 Looks up the biblio's count that has basketno value $basketno
2947 sub GetBiblioCountByBasketno {
2948 my ($basketno) = @_;
2949 my $dbh = C4::Context->dbh;
2951 SELECT COUNT( DISTINCT( biblionumber ) )
2954 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
2957 my $sth = $dbh->prepare($query);
2958 $sth->execute($basketno);
2959 return $sth->fetchrow;
2962 # Note this subroutine should be moved to Koha::Acquisition::Order
2963 # Will do when a DBIC decision will be taken.
2964 sub populate_order_with_prices {
2967 my $order = $params->{order};
2968 my $booksellerid = $params->{booksellerid};
2969 return unless $booksellerid;
2971 my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
2973 my $receiving = $params->{receiving};
2974 my $ordering = $params->{ordering};
2975 my $discount = $order->{discount};
2976 $discount /= 100 if $discount > 1;
2979 $order->{tax_rate_on_ordering} //= $order->{tax_rate};
2980 if ( $bookseller->listincgst ) {
2981 # The user entered the rrp tax included
2982 $order->{rrp_tax_included} = $order->{rrp};
2984 # rrp tax excluded = rrp tax included / ( 1 + tax rate )
2985 $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2987 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2988 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2990 # ecost tax included = rrp tax included ( 1 - discount )
2991 $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
2994 # The user entered the rrp tax excluded
2995 $order->{rrp_tax_excluded} = $order->{rrp};
2997 # rrp tax included = rrp tax excluded * ( 1 - tax rate )
2998 $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
3000 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
3001 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
3003 # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount )
3004 $order->{ecost_tax_included} =
3005 $order->{rrp_tax_excluded} *
3006 ( 1 + $order->{tax_rate_on_ordering} ) *
3010 # tax value = quantity * ecost tax excluded * tax rate
3011 $order->{tax_value_on_ordering} =
3012 $order->{quantity} * $order->{ecost_tax_excluded} * $order->{tax_rate_on_ordering};
3016 $order->{tax_rate_on_receiving} //= $order->{tax_rate};
3017 if ( $bookseller->invoiceincgst ) {
3018 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3019 # we need to keep the exact ecost value
3020 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
3021 $order->{unitprice} = $order->{ecost_tax_included};
3024 # The user entered the unit price tax included
3025 $order->{unitprice_tax_included} = $order->{unitprice};
3027 # unit price tax excluded = unit price tax included / ( 1 + tax rate )
3028 $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
3031 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3032 # we need to keep the exact ecost value
3033 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
3034 $order->{unitprice} = $order->{ecost_tax_excluded};
3037 # The user entered the unit price tax excluded
3038 $order->{unitprice_tax_excluded} = $order->{unitprice};
3041 # unit price tax included = unit price tax included * ( 1 + tax rate )
3042 $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
3045 # tax value = quantity * unit price tax excluded * tax rate
3046 $order->{tax_value_on_receiving} = $order->{quantity} * $order->{unitprice_tax_excluded} * $order->{tax_rate_on_receiving};
3052 =head3 GetOrderUsers
3054 $order_users_ids = &GetOrderUsers($ordernumber);
3056 Returns a list of all borrowernumbers that are in order users list
3061 my ($ordernumber) = @_;
3063 return unless $ordernumber;
3066 SELECT borrowernumber
3068 WHERE ordernumber = ?
3070 my $dbh = C4::Context->dbh;
3071 my $sth = $dbh->prepare($query);
3072 $sth->execute($ordernumber);
3073 my $results = $sth->fetchall_arrayref( {} );
3075 my @borrowernumbers;
3076 foreach (@$results) {
3077 push @borrowernumbers, $_->{'borrowernumber'};
3080 return @borrowernumbers;
3083 =head3 ModOrderUsers
3085 my @order_users_ids = (1, 2, 3);
3086 &ModOrderUsers($ordernumber, @basketusers_ids);
3088 Delete all users from order users list, and add users in C<@order_users_ids>
3094 my ( $ordernumber, @order_users_ids ) = @_;
3096 return unless $ordernumber;
3098 my $dbh = C4::Context->dbh;
3100 DELETE FROM aqorder_users
3101 WHERE ordernumber = ?
3103 my $sth = $dbh->prepare($query);
3104 $sth->execute($ordernumber);
3107 INSERT INTO aqorder_users (ordernumber, borrowernumber)
3110 $sth = $dbh->prepare($query);
3111 foreach my $order_user_id (@order_users_ids) {
3112 $sth->execute( $ordernumber, $order_user_id );
3116 sub NotifyOrderUsers {
3117 my ($ordernumber) = @_;
3119 my @borrowernumbers = GetOrderUsers($ordernumber);
3120 return unless @borrowernumbers;
3122 my $order = GetOrder( $ordernumber );
3123 for my $borrowernumber (@borrowernumbers) {
3124 my $patron = Koha::Patrons->find( $borrowernumber );
3125 my $library = $patron->library->unblessed;
3126 my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed;
3127 my $letter = C4::Letters::GetPreparedLetter(
3128 module => 'acquisition',
3129 letter_code => 'ACQ_NOTIF_ON_RECEIV',
3130 branchcode => $library->{branchcode},
3131 lang => $patron->lang,
3133 'branches' => $library,
3134 'borrowers' => $patron->unblessed,
3135 'biblio' => $biblio,
3136 'aqorders' => $order,
3140 C4::Letters::EnqueueLetter(
3143 borrowernumber => $borrowernumber,
3144 LibraryName => C4::Context->preference("LibraryName"),
3145 message_transport_type => 'email',
3147 ) or warn "can't enqueue letter $letter";
3152 =head3 FillWithDefaultValues
3154 FillWithDefaultValues( $marc_record );
3156 This will update the record with default value defined in the ACQ framework.
3157 For all existing fields, if a default value exists and there are no subfield, it will be created.
3158 If the field does not exist, it will be created too.
3162 sub FillWithDefaultValues {
3164 my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3167 C4::Biblio::GetMarcFromKohaField( 'items.itemnumber', '' );
3168 for my $tag ( sort keys %$tagslib ) {
3170 next if $tag == $itemfield;
3171 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3172 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3173 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3174 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3175 my @fields = $record->field($tag);
3177 for my $field (@fields) {
3178 unless ( defined $field->subfield($subfield) ) {
3179 $field->add_subfields(
3180 $subfield => $defaultvalue );
3185 $record->insert_fields_ordered(
3187 $tag, '', '', $subfield => $defaultvalue
3202 Koha Development Team <http://koha-community.org/>