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>.
22 use Carp qw( carp croak );
25 use C4::Suggestions qw( GetSuggestion GetSuggestionFromBiblionumber ModSuggestion );
26 use C4::Biblio qw( GetMarcFromKohaField GetMarcStructure IsMarcStructureInternal );
27 use C4::Contract qw( GetContract );
28 use C4::Log qw( logaction );
29 use C4::Templates qw(gettemplate);
30 use Koha::DateUtils qw( dt_from_string output_pref );
31 use Koha::Acquisition::Baskets;
32 use Koha::Acquisition::Booksellers;
33 use Koha::Acquisition::Orders;
37 use Koha::Number::Price;
39 use Koha::CsvProfiles;
45 use JSON qw( to_json );
48 our (@ISA, @EXPORT_OK);
53 GetBasket NewBasket ReopenBasket ModBasket
54 GetBasketAsCSV GetBasketGroupAsCSV
55 GetBasketsByBookseller GetBasketsByBasketgroup
56 GetBasketsInfosByBookseller
58 GetBasketUsers ModBasketUsers
63 ModBasketgroup NewBasketgroup DelBasketgroup GetBasketgroup CloseBasketgroup
64 GetBasketgroups ReOpenBasketgroup
66 ModOrder GetOrder GetOrders GetOrdersByBiblionumber
67 GetOrderFromItemnumber
68 SearchOrders GetHistory GetRecentAcqui
69 ModReceiveOrder CancelReceipt
70 populate_order_with_prices
87 GetBiblioCountByBasketno
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;
126 C4::Acquisition - Koha functions for dealing with orders and acquisitions
134 The functions in this module deal with acquisitions, managing book
135 orders, basket and parcels.
139 =head2 FUNCTIONS ABOUT BASKETS
143 $aqbasket = &GetBasket($basketnumber);
145 get all basket informations in aqbasket for a given basket
147 B<returns:> informations for a given basket returned as a hashref.
153 my $dbh = C4::Context->dbh;
156 concat( b.firstname,' ',b.surname) AS authorisedbyname
158 LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
161 my $sth=$dbh->prepare($query);
162 $sth->execute($basketno);
163 my $basket = $sth->fetchrow_hashref;
167 #------------------------------------------------------------#
171 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
172 $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace, $is_standing, $create_items );
174 Create a new basket in aqbasket table
178 =item C<$booksellerid> is a foreign key in the aqbasket table
180 =item C<$authorizedby> is the username of who created the basket
184 The other parameters are optional, see ModBasketHeader for more info on them.
189 my ( $booksellerid, $authorisedby, $basketname, $basketnote,
190 $basketbooksellernote, $basketcontractnumber, $deliveryplace,
191 $billingplace, $is_standing, $create_items ) = @_;
192 my $dbh = C4::Context->dbh;
194 'INSERT INTO aqbasket (creationdate,booksellerid,authorisedby) '
195 . 'VALUES (now(),?,?)';
196 $dbh->do( $query, {}, $booksellerid, $authorisedby );
198 my $basket = $dbh->{mysql_insertid};
199 $basketname ||= q{}; # default to empty strings
201 $basketbooksellernote ||= q{};
203 # Log the basket creation
204 if (C4::Context->preference("AcquisitionLog")) {
205 my $created = Koha::Acquisition::Baskets->find( $basket );
210 to_json($created->unblessed)
214 ModBasketHeader( $basket, $basketname, $basketnote, $basketbooksellernote,
215 $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items );
222 &ReopenBasket($basketno);
230 my $dbh = C4::Context->dbh;
231 $dbh->do( q{UPDATE aqbasket SET closedate=NULL WHERE basketno=?}, {}, $basketno );
235 SET orderstatus = 'new'
237 AND orderstatus NOT IN ( 'complete', 'cancelled' )
240 # Log the basket reopening
241 if (C4::Context->preference("AcquisitionLog")) {
242 my $reopened = Koha::Acquisition::Baskets->find( $basketno );
247 to_json($reopened->unblessed)
253 #------------------------------------------------------------#
255 =head3 GetBasketAsCSV
257 &GetBasketAsCSV($basketno);
259 Export a basket as CSV
261 $cgi parameter is needed for column name translation
266 my ($basketno, $cgi, $csv_profile_id) = @_;
267 my $basket = GetBasket($basketno);
268 my @orders = GetOrders($basketno);
269 my $contract = GetContract({
270 contractnumber => $basket->{'contractnumber'}
273 my $template = C4::Templates::gettemplate("acqui/csv/basket.tt", "intranet", $cgi);
275 if ($csv_profile_id) {
276 my $csv_profile = Koha::CsvProfiles->find( $csv_profile_id );
277 Koha::Exceptions::ObjectNotFound->throw( 'There is no valid csv profile given') unless $csv_profile;
279 my $delimiter = $csv_profile->csv_separator;
280 $delimiter = "\t" if $delimiter eq "\\t";
281 my $csv = Text::CSV_XS->new({'quote_char'=>'"','escape_char'=>'"','sep_char'=>$delimiter,'binary'=>1});
282 my $csv_profile_content = $csv_profile->content;
283 my ( @headers, @fields );
284 while ( $csv_profile_content =~ /
287 ([^\|]*) # fieldname (table.row or row)
291 my $field = ($2 eq '') ? $1 : $2;
293 $header =~ s/^\s+|\s+$//g; # Trim whitespaces
294 push @headers, $header;
296 $field =~ s/[^\.]*\.{1}//; # Remove the table name if exists.
297 $field =~ s/^\s+|\s+$//g; # Trim whitespaces
298 push @fields, $field;
300 for my $order (@orders) {
302 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
303 my $biblioitem = $biblio->biblioitem;
304 $order = { %$order, %{ $biblioitem->unblessed } };
306 $order = {%$order, %$contract};
308 $order = {%$order, %$basket, %{ $biblio->unblessed }};
309 for my $field (@fields) {
310 push @row, $order->{$field};
314 my $content = join( $delimiter, @headers ) . "\n";
315 for my $row ( @rows ) {
316 $csv->combine(@$row);
317 my $string = $csv->string;
318 $content .= $string . "\n";
323 foreach my $order (@orders) {
324 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
325 my $biblioitem = $biblio->biblioitem;
327 contractname => $contract->{'contractname'},
328 ordernumber => $order->{'ordernumber'},
329 entrydate => $order->{'entrydate'},
330 isbn => $order->{'isbn'},
331 author => $biblio->author,
332 title => $biblio->title,
333 publicationyear => $biblioitem->publicationyear,
334 publishercode => $biblioitem->publishercode,
335 collectiontitle => $biblioitem->collectiontitle,
336 notes => $order->{'order_vendornote'},
337 quantity => $order->{'quantity'},
338 rrp => $order->{'rrp'},
340 for my $place ( qw( deliveryplace billingplace ) ) {
341 if ( my $library = Koha::Libraries->find( $row->{deliveryplace} ) ) {
342 $row->{$place} = $library->branchname
346 contractname author title publishercode collectiontitle notes
347 deliveryplace billingplace
349 # Double the quotes to not be interpreted as a field end
350 $row->{$_} =~ s/"/""/g if $row->{$_};
356 if(defined $a->{publishercode} and defined $b->{publishercode}) {
357 $a->{publishercode} cmp $b->{publishercode};
361 $template->param(rows => \@rows);
363 return $template->output;
368 =head3 GetBasketGroupAsCSV
370 &GetBasketGroupAsCSV($basketgroupid);
372 Export a basket group as CSV
374 $cgi parameter is needed for column name translation
378 sub GetBasketGroupAsCSV {
379 my ($basketgroupid, $cgi) = @_;
380 my $baskets = GetBasketsByBasketgroup($basketgroupid);
382 my $template = C4::Templates::gettemplate('acqui/csv/basketgroup.tt', 'intranet', $cgi);
385 for my $basket (@$baskets) {
386 my @orders = GetOrders( $basket->{basketno} );
387 my $contract = GetContract({
388 contractnumber => $basket->{contractnumber}
390 my $bookseller = Koha::Acquisition::Booksellers->find( $basket->{booksellerid} );
391 my $basketgroup = GetBasketgroup( $$basket{basketgroupid} );
393 foreach my $order (@orders) {
394 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
395 my $biblioitem = $biblio->biblioitem;
397 clientnumber => $bookseller->accountnumber,
398 basketname => $basket->{basketname},
399 ordernumber => $order->{ordernumber},
400 author => $biblio->author,
401 title => $biblio->title,
402 publishercode => $biblioitem->publishercode,
403 publicationyear => $biblioitem->publicationyear,
404 collectiontitle => $biblioitem->collectiontitle,
405 isbn => $order->{isbn},
406 quantity => $order->{quantity},
407 rrp_tax_included => $order->{rrp_tax_included},
408 rrp_tax_excluded => $order->{rrp_tax_excluded},
409 discount => $bookseller->discount,
410 ecost_tax_included => $order->{ecost_tax_included},
411 ecost_tax_excluded => $order->{ecost_tax_excluded},
412 notes => $order->{order_vendornote},
413 entrydate => $order->{entrydate},
414 booksellername => $bookseller->name,
415 bookselleraddress => $bookseller->address1,
416 booksellerpostal => $bookseller->postal,
417 contractnumber => $contract->{contractnumber},
418 contractname => $contract->{contractname},
421 basketgroupdeliveryplace => $basketgroup->{deliveryplace},
422 basketgroupbillingplace => $basketgroup->{billingplace},
423 basketdeliveryplace => $basket->{deliveryplace},
424 basketbillingplace => $basket->{billingplace},
426 for my $place (qw( basketgroupdeliveryplace basketgroupbillingplace basketdeliveryplace basketbillingplace )) {
427 if ( my $library = Koha::Libraries->find( $temp->{$place} ) ) {
428 $row->{$place} = $library->branchname;
432 basketname author title publishercode collectiontitle notes
433 booksellername bookselleraddress booksellerpostal contractname
434 basketgroupdeliveryplace basketgroupbillingplace
435 basketdeliveryplace basketbillingplace
437 # Double the quotes to not be interpreted as a field end
438 $row->{$_} =~ s/"/""/g if $row->{$_};
443 $template->param(rows => \@rows);
445 return $template->output;
449 =head3 CloseBasketgroup
451 &CloseBasketgroup($basketgroupno);
457 sub CloseBasketgroup {
458 my ($basketgroupno) = @_;
459 my $dbh = C4::Context->dbh;
460 my $sth = $dbh->prepare("
461 UPDATE aqbasketgroups
465 $sth->execute($basketgroupno);
468 #------------------------------------------------------------#
470 =head3 ReOpenBaskergroup($basketgroupno)
472 &ReOpenBaskergroup($basketgroupno);
478 sub ReOpenBasketgroup {
479 my ($basketgroupno) = @_;
480 my $dbh = C4::Context->dbh;
481 my $sth = $dbh->prepare("
482 UPDATE aqbasketgroups
486 $sth->execute($basketgroupno);
489 #------------------------------------------------------------#
493 &ModBasket($basketinfo);
495 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
499 =item C<$basketno> is the primary key of the basket in the aqbasket table.
506 my $basketinfo = shift;
507 my $query = "UPDATE aqbasket SET ";
509 foreach my $key (keys %$basketinfo){
510 if ($key ne 'basketno'){
511 $query .= "$key=?, ";
512 push(@params, $basketinfo->{$key} || undef );
515 # get rid of the "," at the end of $query
516 if (substr($query, length($query)-2) eq ', '){
521 $query .= "WHERE basketno=?";
522 push(@params, $basketinfo->{'basketno'});
523 my $dbh = C4::Context->dbh;
524 my $sth = $dbh->prepare($query);
525 $sth->execute(@params);
527 # Log the basket update
528 if (C4::Context->preference("AcquisitionLog")) {
529 my $modified = Koha::Acquisition::Baskets->find(
530 $basketinfo->{basketno}
535 $basketinfo->{basketno},
536 to_json($modified->unblessed)
543 #------------------------------------------------------------#
545 =head3 ModBasketHeader
547 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
549 Modifies a basket's header.
553 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
555 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
557 =item C<$note> is the "note" field in the "aqbasket" table;
559 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
561 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
563 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
565 =item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
567 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
569 =item C<$is_standing> is the "is_standing" field in the aqbasket table.
571 =item C<$create_items> should be set to 'ordering', 'receiving' or 'cataloguing' (or undef, in which
572 case the AcqCreateItem syspref takes precedence).
578 sub ModBasketHeader {
579 my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items) = @_;
584 SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=?, is_standing=?, create_items=?
588 my $dbh = C4::Context->dbh;
589 my $sth = $dbh->prepare($query);
590 $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items || undef, $basketno);
592 if ( $contractnumber ) {
593 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
594 my $sth2 = $dbh->prepare($query2);
595 $sth2->execute($contractnumber,$basketno);
598 # Log the basket update
599 if (C4::Context->preference("AcquisitionLog")) {
600 my $modified = Koha::Acquisition::Baskets->find(
605 'MODIFY_BASKET_HEADER',
607 to_json($modified->unblessed)
614 #------------------------------------------------------------#
616 =head3 GetBasketsByBookseller
618 @results = &GetBasketsByBookseller($booksellerid, $extra);
620 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
624 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
626 =item C<$extra> is the extra sql parameters, can be
628 $extra->{groupby}: group baskets by column
629 ex. $extra->{groupby} = aqbasket.basketgroupid
630 $extra->{orderby}: order baskets by column
631 $extra->{limit}: limit number of results (can be helpful for pagination)
637 sub GetBasketsByBookseller {
638 my ($booksellerid, $extra) = @_;
639 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
641 if ($extra->{groupby}) {
642 $query .= " GROUP by $extra->{groupby}";
644 if ($extra->{orderby}){
645 $query .= " ORDER by $extra->{orderby}";
647 if ($extra->{limit}){
648 $query .= " LIMIT $extra->{limit}";
651 my $dbh = C4::Context->dbh;
652 my $sth = $dbh->prepare($query);
653 $sth->execute($booksellerid);
654 return $sth->fetchall_arrayref({});
657 =head3 GetBasketsInfosByBookseller
659 my $baskets = GetBasketsInfosByBookseller($supplierid, $allbaskets);
661 The optional second parameter allbaskets is a boolean allowing you to
662 select all baskets from the supplier; by default only active baskets (open or
663 closed but still something to receive) are returned.
665 Returns in a arrayref of hashref all about booksellers baskets, plus:
666 total_biblios: Number of distinct biblios in basket
667 total_items: Number of items in basket
668 expected_items: Number of non-received items in basket
672 sub GetBasketsInfosByBookseller {
673 my ($supplierid, $allbaskets) = @_;
675 return unless $supplierid;
677 my $dbh = C4::Context->dbh;
679 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,
680 SUM(aqorders.quantity) AS total_items,
682 IF ( aqorders.orderstatus = 'cancelled', aqorders.quantity, 0 )
683 ) AS total_items_cancelled,
684 COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
686 IF(aqorders.datereceived IS NULL
687 AND aqorders.datecancellationprinted IS NULL
691 SUM( aqorders.uncertainprice ) AS uncertainprices
693 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
694 WHERE booksellerid = ?};
696 $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";
698 unless ( $allbaskets ) {
699 # Don't show the basket if it's NOT CLOSED or is FULLY RECEIVED
700 $query.=" HAVING (closedate IS NULL OR (
702 IF(aqorders.datereceived IS NULL
703 AND aqorders.datecancellationprinted IS NULL
709 my $sth = $dbh->prepare($query);
710 $sth->execute($supplierid);
711 my $baskets = $sth->fetchall_arrayref({});
713 # Retrieve the number of biblios cancelled
714 my $cancelled_biblios = $dbh->selectall_hashref( q|
715 SELECT COUNT(DISTINCT(biblionumber)) AS total_biblios_cancelled, aqbasket.basketno
717 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
718 WHERE booksellerid = ?
719 AND aqorders.orderstatus = 'cancelled'
720 GROUP BY aqbasket.basketno
721 |, 'basketno', {}, $supplierid );
723 $_->{total_biblios_cancelled} = $cancelled_biblios->{$_->{basketno}}{total_biblios_cancelled} || 0
729 =head3 GetBasketUsers
731 $basketusers_ids = &GetBasketUsers($basketno);
733 Returns a list of all borrowernumbers that are in basket users list
738 my $basketno = shift;
740 return unless $basketno;
743 SELECT borrowernumber
747 my $dbh = C4::Context->dbh;
748 my $sth = $dbh->prepare($query);
749 $sth->execute($basketno);
750 my $results = $sth->fetchall_arrayref( {} );
753 foreach (@$results) {
754 push @borrowernumbers, $_->{'borrowernumber'};
757 return @borrowernumbers;
760 =head3 ModBasketUsers
762 my @basketusers_ids = (1, 2, 3);
763 &ModBasketUsers($basketno, @basketusers_ids);
765 Delete all users from basket users list, and add users in C<@basketusers_ids>
771 my ($basketno, @basketusers_ids) = @_;
773 return unless $basketno;
775 my $dbh = C4::Context->dbh;
777 DELETE FROM aqbasketusers
780 my $sth = $dbh->prepare($query);
781 $sth->execute($basketno);
784 INSERT INTO aqbasketusers (basketno, borrowernumber)
787 $sth = $dbh->prepare($query);
788 foreach my $basketuser_id (@basketusers_ids) {
789 $sth->execute($basketno, $basketuser_id);
792 # Log the basket update
793 if (C4::Context->preference("AcquisitionLog")) {
796 'MODIFY_BASKET_USERS',
799 basketno => $basketno,
800 basketusers => @basketusers_ids
808 =head3 CanUserManageBasket
810 my $bool = CanUserManageBasket($borrower, $basket[, $userflags]);
811 my $bool = CanUserManageBasket($borrowernumber, $basketno[, $userflags]);
813 Check if a borrower can manage a basket, according to system preference
814 AcqViewBaskets, user permissions and basket properties (creator, users list,
817 First parameter can be either a borrowernumber or a hashref as returned by
818 Koha::Patron->unblessed
820 Second parameter can be either a basketno or a hashref as returned by
821 C4::Acquisition::GetBasket.
823 The third parameter is optional. If given, it should be a hashref as returned
824 by C4::Auth::getuserflags. If not, getuserflags is called.
826 If user is authorised to manage basket, returns 1.
831 sub CanUserManageBasket {
832 my ($borrower, $basket, $userflags) = @_;
834 if (!ref $borrower) {
835 # FIXME This needs to be replaced
836 # We should not accept both scalar and array
837 # Tests need to be updated
838 $borrower = Koha::Patrons->find( $borrower )->unblessed;
841 $basket = GetBasket($basket);
844 return 0 unless ($basket and $borrower);
846 my $borrowernumber = $borrower->{borrowernumber};
847 my $basketno = $basket->{basketno};
849 my $AcqViewBaskets = C4::Context->preference('AcqViewBaskets');
851 if (!defined $userflags) {
852 my $dbh = C4::Context->dbh;
853 my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE borrowernumber = ?");
854 $sth->execute($borrowernumber);
855 my ($flags) = $sth->fetchrow_array;
858 $userflags = C4::Auth::getuserflags($flags, $borrower->{userid}, $dbh);
861 unless ($userflags->{superlibrarian}
862 || (ref $userflags->{acquisition} && $userflags->{acquisition}->{order_manage_all})
863 || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
865 if (not exists $userflags->{acquisition}) {
869 if ( (ref $userflags->{acquisition} && !$userflags->{acquisition}->{order_manage})
870 || (!ref $userflags->{acquisition} && !$userflags->{acquisition}) ) {
874 if ($AcqViewBaskets eq 'user'
875 && $basket->{authorisedby} != $borrowernumber
876 && ! grep { $borrowernumber eq $_ } GetBasketUsers($basketno)) {
880 if ($AcqViewBaskets eq 'branch' && defined $basket->{branch}
881 && $basket->{branch} ne $borrower->{branchcode}) {
889 #------------------------------------------------------------#
891 =head3 GetBasketsByBasketgroup
893 $baskets = &GetBasketsByBasketgroup($basketgroupid);
895 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
899 sub GetBasketsByBasketgroup {
900 my $basketgroupid = shift;
902 SELECT *, aqbasket.booksellerid as booksellerid
904 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?
906 my $dbh = C4::Context->dbh;
907 my $sth = $dbh->prepare($query);
908 $sth->execute($basketgroupid);
909 return $sth->fetchall_arrayref({});
912 #------------------------------------------------------------#
914 =head3 NewBasketgroup
916 $basketgroupid = NewBasketgroup(\%hashref);
918 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
920 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
922 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
924 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
926 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
928 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
930 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
932 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
934 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
939 my $basketgroupinfo = shift;
940 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
941 my $query = "INSERT INTO aqbasketgroups (";
943 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
944 if ( defined $basketgroupinfo->{$field} ) {
945 $query .= "$field, ";
946 push(@params, $basketgroupinfo->{$field});
949 $query .= "booksellerid) VALUES (";
954 push(@params, $basketgroupinfo->{'booksellerid'});
955 my $dbh = C4::Context->dbh;
956 my $sth = $dbh->prepare($query);
957 $sth->execute(@params);
958 my $basketgroupid = $dbh->{'mysql_insertid'};
959 if( $basketgroupinfo->{'basketlist'} ) {
960 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
961 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
962 my $sth2 = $dbh->prepare($query2);
963 $sth2->execute($basketgroupid, $basketno);
966 return $basketgroupid;
969 #------------------------------------------------------------#
971 =head3 ModBasketgroup
973 ModBasketgroup(\%hashref);
975 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
977 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
979 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
981 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
983 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
985 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
987 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
989 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
991 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
996 my $basketgroupinfo = shift;
997 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
998 my $dbh = C4::Context->dbh;
999 my $query = "UPDATE aqbasketgroups SET ";
1001 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
1002 if ( defined $basketgroupinfo->{$field} ) {
1003 $query .= "$field=?, ";
1004 push(@params, $basketgroupinfo->{$field});
1009 $query .= " WHERE id=?";
1010 push(@params, $basketgroupinfo->{'id'});
1011 my $sth = $dbh->prepare($query);
1012 $sth->execute(@params);
1014 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
1015 $sth->execute($basketgroupinfo->{'id'});
1017 if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
1018 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
1019 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
1020 $sth->execute($basketgroupinfo->{'id'}, $basketno);
1026 #------------------------------------------------------------#
1028 =head3 DelBasketgroup
1030 DelBasketgroup($basketgroupid);
1032 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
1036 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
1042 sub DelBasketgroup {
1043 my $basketgroupid = shift;
1044 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1045 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
1046 my $dbh = C4::Context->dbh;
1047 my $sth = $dbh->prepare($query);
1048 $sth->execute($basketgroupid);
1052 #------------------------------------------------------------#
1055 =head2 FUNCTIONS ABOUT ORDERS
1057 =head3 GetBasketgroup
1059 $basketgroup = &GetBasketgroup($basketgroupid);
1061 Returns a reference to the hash containing all information about the basketgroup.
1065 sub GetBasketgroup {
1066 my $basketgroupid = shift;
1067 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1068 my $dbh = C4::Context->dbh;
1069 my $result_set = $dbh->selectall_arrayref(
1070 'SELECT * FROM aqbasketgroups WHERE id=?',
1074 return $result_set->[0]; # id is unique
1077 #------------------------------------------------------------#
1079 =head3 GetBasketgroups
1081 $basketgroups = &GetBasketgroups($booksellerid);
1083 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
1087 sub GetBasketgroups {
1088 my $booksellerid = shift;
1089 die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
1090 my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
1091 my $dbh = C4::Context->dbh;
1092 my $sth = $dbh->prepare($query);
1093 $sth->execute($booksellerid);
1094 return $sth->fetchall_arrayref({});
1097 #------------------------------------------------------------#
1099 =head2 FUNCTIONS ABOUT ORDERS
1103 @orders = &GetOrders( $basketno, { orderby => 'biblio.title', cancelled => 0|1 } );
1105 Looks up the pending (non-cancelled) orders with the given basket
1108 If cancelled is set, only cancelled orders will be returned.
1113 my ( $basketno, $params ) = @_;
1115 return () unless $basketno;
1117 my $orderby = $params->{orderby};
1118 my $cancelled = $params->{cancelled} || 0;
1120 my $dbh = C4::Context->dbh;
1122 SELECT biblio.*,biblioitems.*,
1126 $query .= $cancelled
1128 aqorders_transfers.ordernumber_to AS transferred_to,
1129 aqorders_transfers.timestamp AS transferred_to_timestamp
1132 aqorders_transfers.ordernumber_from AS transferred_from,
1133 aqorders_transfers.timestamp AS transferred_from_timestamp
1137 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1138 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1139 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1141 $query .= $cancelled
1143 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
1146 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1154 $orderby ||= q|biblioitems.publishercode, biblio.title|;
1156 AND datecancellationprinted IS NOT NULL
1161 q|aqorders.datecancellationprinted desc, aqorders.timestamp desc|;
1163 AND datecancellationprinted IS NULL
1167 $query .= " ORDER BY $orderby";
1169 $dbh->selectall_arrayref( $query, { Slice => {} }, $basketno );
1174 #------------------------------------------------------------#
1176 =head3 GetOrdersByBiblionumber
1178 @orders = &GetOrdersByBiblionumber($biblionumber);
1180 Looks up the orders with linked to a specific $biblionumber, including
1181 cancelled orders and received orders.
1184 C<@orders> is an array of references-to-hash, whose keys are the
1185 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
1189 sub GetOrdersByBiblionumber {
1190 my $biblionumber = shift;
1191 return unless $biblionumber;
1192 my $dbh = C4::Context->dbh;
1194 SELECT biblio.*,biblioitems.*,
1198 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1199 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1200 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1201 WHERE aqorders.biblionumber=?
1204 $dbh->selectall_arrayref( $query, { Slice => {} }, $biblionumber );
1205 return @{$result_set};
1209 #------------------------------------------------------------#
1213 $order = &GetOrder($ordernumber);
1215 Looks up an order by order number.
1217 Returns a reference-to-hash describing the order. The keys of
1218 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1223 my ($ordernumber) = @_;
1224 return unless $ordernumber;
1226 my $dbh = C4::Context->dbh;
1227 my $query = qq{SELECT
1231 aqbasket.basketname,
1232 borrowers.branchcode,
1233 biblioitems.publicationyear,
1234 biblio.copyrightdate,
1235 biblioitems.editionstatement,
1239 biblioitems.publishercode,
1240 aqorders.rrp AS unitpricesupplier,
1241 aqorders.ecost AS unitpricelib,
1242 aqbudgets.budget_name AS budget,
1243 aqbooksellers.name AS supplier,
1244 aqbooksellers.id AS supplierid,
1245 biblioitems.publishercode AS publisher,
1246 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1247 DATE(aqbasket.closedate) AS orderdate,
1248 aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity_to_receive,
1249 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1250 DATEDIFF(CURDATE( ),closedate) AS latesince
1251 FROM aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1252 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1253 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1254 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
1255 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1256 WHERE aqorders.basketno = aqbasket.basketno
1259 $dbh->selectall_arrayref( $query, { Slice => {} }, $ordernumber );
1261 # result_set assumed to contain 1 match
1262 return $result_set->[0];
1267 &ModOrder(\%hashref);
1269 Modifies an existing order. Updates the order with order number
1270 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1271 other keys of the hash update the fields with the same name in the aqorders
1272 table of the Koha database.
1277 my $orderinfo = shift;
1279 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '';
1281 my $dbh = C4::Context->dbh;
1284 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1285 $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1287 # delete($orderinfo->{'branchcode'});
1288 # the hash contains a lot of entries not in aqorders, so get the columns ...
1289 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1291 my $colnames = $sth->{NAME};
1292 #FIXME Be careful. If aqorders would have columns with diacritics,
1293 #you should need to decode what you get back from NAME.
1294 #See report 10110 and guided_reports.pl
1295 my $query = "UPDATE aqorders SET ";
1297 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1298 # ... and skip hash entries that are not in the aqorders table
1299 # FIXME : probably not the best way to do it (would be better to have a correct hash)
1300 next unless grep { $_ eq $orderinfokey } @$colnames;
1301 $query .= "$orderinfokey=?, ";
1302 push(@params, $orderinfo->{$orderinfokey});
1305 $query .= "timestamp=NOW() WHERE ordernumber=?";
1306 push(@params, $orderinfo->{'ordernumber'} );
1307 $sth = $dbh->prepare($query);
1308 $sth->execute(@params);
1312 #------------------------------------------------------------#
1316 ModItemOrder($itemnumber, $ordernumber);
1318 Modifies the ordernumber of an item in aqorders_items.
1323 my ($itemnumber, $ordernumber) = @_;
1325 return unless ($itemnumber and $ordernumber);
1327 my $dbh = C4::Context->dbh;
1329 UPDATE aqorders_items
1331 WHERE itemnumber = ?
1333 my $sth = $dbh->prepare($query);
1334 return $sth->execute($ordernumber, $itemnumber);
1337 #------------------------------------------------------------#
1339 =head3 ModReceiveOrder
1341 my ( $date_received, $new_ordernumber ) = ModReceiveOrder(
1343 biblionumber => $biblionumber,
1345 quantityreceived => $quantityreceived,
1347 invoice => $invoice,
1348 budget_id => $budget_id,
1349 datereceived => $datereceived,
1350 received_itemnumbers => \@received_itemnumbers,
1354 Updates an order, to reflect the fact that it was received, at least
1357 If a partial order is received, splits the order into two.
1359 Updates the order with biblionumber C<$biblionumber> and ordernumber
1360 C<$order->{ordernumber}>.
1365 sub ModReceiveOrder {
1367 my $biblionumber = $params->{biblionumber};
1368 my $order = { %{ $params->{order} } }; # Copy the order, we don't want to modify it
1369 my $invoice = $params->{invoice};
1370 my $quantrec = $params->{quantityreceived};
1371 my $user = $params->{user};
1372 my $budget_id = $params->{budget_id};
1373 my $datereceived = $params->{datereceived};
1374 my $received_items = $params->{received_items};
1376 my $dbh = C4::Context->dbh;
1377 $datereceived = output_pref(
1379 dt => ( $datereceived ? dt_from_string( $datereceived ) : dt_from_string ),
1380 dateformat => 'iso',
1385 my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1386 if ($suggestionid) {
1387 ModSuggestion( {suggestionid=>$suggestionid,
1388 STATUS=>'AVAILABLE',
1389 biblionumber=> $biblionumber}
1393 my $result_set = $dbh->selectrow_arrayref(
1394 q{SELECT aqbasket.is_standing
1396 WHERE basketno=?},{ Slice => {} }, $order->{basketno});
1397 my $is_standing = $result_set->[0]; # we assume we have a unique basket
1399 my $new_ordernumber = $order->{ordernumber};
1400 if ( $is_standing || $order->{quantity} > $quantrec ) {
1401 # Split order line in two parts: the first is the original order line
1402 # without received items (the quantity is decreased),
1403 # the second part is a new order line with quantity=quantityrec
1404 # (entirely received)
1408 orderstatus = 'partial'|;
1409 $query .= q| WHERE ordernumber = ?|;
1410 my $sth = $dbh->prepare($query);
1413 ( $is_standing ? 1 : ($order->{quantity} - $quantrec) ),
1414 $order->{ordernumber}
1417 if ( not $order->{subscriptionid} && defined $order->{order_internalnote} ) {
1420 SET order_internalnote = ?
1421 WHERE ordernumber = ?|, {},
1422 $order->{order_internalnote}, $order->{ordernumber}
1426 # Recalculate tax_value
1430 tax_value_on_ordering = quantity * | . get_rounding_sql(q|ecost_tax_excluded|) . q| * tax_rate_on_ordering,
1431 tax_value_on_receiving = quantity * | . get_rounding_sql(q|unitprice_tax_excluded|) . q| * tax_rate_on_receiving
1432 WHERE ordernumber = ?
1433 |, undef, $order->{ordernumber});
1435 delete $order->{ordernumber};
1436 $order->{budget_id} = ( $budget_id || $order->{budget_id} );
1437 $order->{quantity} = $quantrec;
1438 $order->{quantityreceived} = $quantrec;
1439 $order->{ecost_tax_excluded} //= 0;
1440 $order->{tax_rate_on_ordering} //= 0;
1441 $order->{unitprice_tax_excluded} //= 0;
1442 $order->{tax_rate_on_receiving} //= 0;
1443 $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($order->{ecost_tax_excluded}) * $order->{tax_rate_on_ordering};
1444 $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
1445 $order->{datereceived} = $datereceived;
1446 $order->{invoiceid} = $invoice->{invoiceid};
1447 $order->{orderstatus} = 'complete';
1448 $new_ordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber; # TODO What if the store fails?
1450 if ($received_items) {
1451 foreach my $itemnumber (@$received_items) {
1452 ModItemOrder($itemnumber, $new_ordernumber);
1458 SET quantityreceived = ?,
1462 orderstatus = 'complete'
1466 , replacementprice = ?
1467 | if defined $order->{replacementprice};
1470 , unitprice = ?, unitprice_tax_included = ?, unitprice_tax_excluded = ?
1471 | if defined $order->{unitprice};
1474 ,tax_value_on_receiving = ?
1475 | if defined $order->{tax_value_on_receiving};
1478 ,tax_rate_on_receiving = ?
1479 | if defined $order->{tax_rate_on_receiving};
1482 , order_internalnote = ?
1483 | if defined $order->{order_internalnote};
1485 $query .= q| where biblionumber=? and ordernumber=?|;
1487 my $sth = $dbh->prepare( $query );
1488 my @params = ( $quantrec, $datereceived, $invoice->{invoiceid}, ( $budget_id ? $budget_id : $order->{budget_id} ) );
1490 if ( defined $order->{replacementprice} ) {
1491 push @params, $order->{replacementprice};
1494 if ( defined $order->{unitprice} ) {
1495 push @params, $order->{unitprice}, $order->{unitprice_tax_included}, $order->{unitprice_tax_excluded};
1498 if ( defined $order->{tax_value_on_receiving} ) {
1499 push @params, $order->{tax_value_on_receiving};
1502 if ( defined $order->{tax_rate_on_receiving} ) {
1503 push @params, $order->{tax_rate_on_receiving};
1506 if ( defined $order->{order_internalnote} ) {
1507 push @params, $order->{order_internalnote};
1510 push @params, ( $biblionumber, $order->{ordernumber} );
1512 $sth->execute( @params );
1514 # All items have been received, sent a notification to users
1515 NotifyOrderUsers( $order->{ordernumber} );
1518 return ($datereceived, $new_ordernumber);
1521 =head3 CancelReceipt
1523 my $parent_ordernumber = CancelReceipt($ordernumber);
1525 Cancel an order line receipt and update the parent order line, as if no
1527 If items are created at receipt (AcqCreateItem = receiving) then delete
1533 my $ordernumber = shift;
1535 return unless $ordernumber;
1537 my $dbh = C4::Context->dbh;
1539 SELECT datereceived, parent_ordernumber, quantity
1541 WHERE ordernumber = ?
1543 my $sth = $dbh->prepare($query);
1544 $sth->execute($ordernumber);
1545 my $order = $sth->fetchrow_hashref;
1547 warn "CancelReceipt: order $ordernumber does not exist";
1550 unless($order->{'datereceived'}) {
1551 warn "CancelReceipt: order $ordernumber is not received";
1555 my $parent_ordernumber = $order->{'parent_ordernumber'};
1557 my $order_obj = Koha::Acquisition::Orders->find( $ordernumber ); # FIXME rewrite all this subroutine using this object
1558 my @itemnumbers = $order_obj->items->get_column('itemnumber');
1560 if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1561 # The order line has no parent, just mark it as not received
1564 SET quantityreceived = ?,
1567 orderstatus = 'ordered'
1568 WHERE ordernumber = ?
1570 $sth = $dbh->prepare($query);
1571 $sth->execute(0, undef, undef, $ordernumber);
1572 _cancel_items_receipt( $order_obj );
1574 # The order line has a parent, increase parent quantity and delete
1576 unless ( $order_obj->basket->is_standing ) {
1578 SELECT quantity, datereceived
1580 WHERE ordernumber = ?
1582 $sth = $dbh->prepare($query);
1583 $sth->execute($parent_ordernumber);
1584 my $parent_order = $sth->fetchrow_hashref;
1585 unless($parent_order) {
1586 warn "Parent order $parent_ordernumber does not exist.";
1589 if($parent_order->{'datereceived'}) {
1590 warn "CancelReceipt: parent order is received.".
1591 " Can't cancel receipt.";
1597 orderstatus = 'ordered'
1598 WHERE ordernumber = ?
1600 $sth = $dbh->prepare($query);
1601 my $rv = $sth->execute(
1602 $order->{'quantity'} + $parent_order->{'quantity'},
1606 warn "Cannot update parent order line, so do not cancel".
1611 # Recalculate tax_value
1615 tax_value_on_ordering = quantity * | . get_rounding_sql(q|ecost_tax_excluded|) . q| * tax_rate_on_ordering,
1616 tax_value_on_receiving = quantity * | . get_rounding_sql(q|unitprice_tax_excluded|) . q| * tax_rate_on_receiving
1617 WHERE ordernumber = ?
1618 |, undef, $parent_ordernumber);
1621 _cancel_items_receipt( $order_obj, $parent_ordernumber );
1624 DELETE FROM aqorders
1625 WHERE ordernumber = ?
1627 $sth = $dbh->prepare($query);
1628 $sth->execute($ordernumber);
1632 if( $order_obj->basket->effective_create_items eq 'ordering' ) {
1633 my @affects = split q{\|}, C4::Context->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1635 for my $in ( @itemnumbers ) {
1636 my $item = Koha::Items->find( $in ); # FIXME We do not need that, we already have Koha::Items from $order_obj->items
1637 my $biblio = $item->biblio;
1638 my ( $itemfield ) = GetMarcFromKohaField( 'items.itemnumber' );
1639 my $item_marc = C4::Items::GetMarcItem( $biblio->biblionumber, $in );
1640 for my $affect ( @affects ) {
1641 my ( $sf, $v ) = split q{=}, $affect, 2;
1642 foreach ( $item_marc->field($itemfield) ) {
1643 $_->update( $sf => $v );
1646 C4::Items::ModItemFromMarc( $item_marc, $biblio->biblionumber, $in );
1651 return $parent_ordernumber;
1654 sub _cancel_items_receipt {
1655 my ( $order, $parent_ordernumber ) = @_;
1656 $parent_ordernumber ||= $order->ordernumber;
1658 my $items = $order->items;
1659 if ( $order->basket->effective_create_items eq 'receiving' ) {
1660 # Remove items that were created at receipt
1662 DELETE FROM items, aqorders_items
1663 USING items, aqorders_items
1664 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1666 my $dbh = C4::Context->dbh;
1667 my $sth = $dbh->prepare($query);
1668 while ( my $item = $items->next ) {
1669 $sth->execute($item->itemnumber, $item->itemnumber);
1673 while ( my $item = $items->next ) {
1674 ModItemOrder($item->itemnumber, $parent_ordernumber);
1679 #------------------------------------------------------------#
1683 @results = &SearchOrders({
1684 ordernumber => $ordernumber,
1687 booksellerid => $booksellerid,
1688 basketno => $basketno,
1689 basketname => $basketname,
1690 basketgroupname => $basketgroupname,
1694 biblionumber => $biblionumber,
1695 budget_id => $budget_id
1698 Searches for orders filtered by criteria.
1700 C<$ordernumber> Finds matching orders or transferred orders by ordernumber.
1701 C<$search> Finds orders matching %$search% in title, author, or isbn.
1702 C<$owner> Finds order for the logged in user.
1703 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1704 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1707 C<@results> is an array of references-to-hash with the keys are fields
1708 from aqorders, biblio, biblioitems and aqbasket tables.
1713 my ( $params ) = @_;
1714 my $ordernumber = $params->{ordernumber};
1715 my $search = $params->{search};
1716 my $ean = $params->{ean};
1717 my $booksellerid = $params->{booksellerid};
1718 my $basketno = $params->{basketno};
1719 my $basketname = $params->{basketname};
1720 my $basketgroupname = $params->{basketgroupname};
1721 my $owner = $params->{owner};
1722 my $pending = $params->{pending};
1723 my $ordered = $params->{ordered};
1724 my $biblionumber = $params->{biblionumber};
1725 my $budget_id = $params->{budget_id};
1727 my $dbh = C4::Context->dbh;
1730 SELECT aqbasket.basketno,
1732 borrowers.firstname,
1735 biblioitems.biblioitemnumber,
1736 biblioitems.publishercode,
1737 biblioitems.publicationyear,
1738 aqbasket.authorisedby,
1739 aqbasket.booksellerid,
1741 aqbasket.creationdate,
1742 aqbasket.basketname,
1743 aqbasketgroups.id as basketgroupid,
1744 aqbasketgroups.name as basketgroupname,
1747 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1748 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1749 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1750 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1751 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1754 # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
1756 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1760 WHERE (datecancellationprinted is NULL)
1763 if ( $pending or $ordered ) {
1766 ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) )
1768 ( quantity > quantityreceived OR quantityreceived is NULL )
1772 $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1780 my $userenv = C4::Context->userenv;
1781 if ( C4::Context->preference("IndependentBranches") ) {
1782 unless ( C4::Context->IsSuperLibrarian() ) {
1785 borrowers.branchcode = ?
1786 OR borrowers.branchcode = ''
1789 push @args, $userenv->{branch};
1793 if ( $ordernumber ) {
1794 $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1795 push @args, ( $ordernumber, $ordernumber );
1797 if ( $biblionumber ) {
1798 $query .= 'AND aqorders.biblionumber = ?';
1799 push @args, $biblionumber;
1802 $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1803 push @args, ("%$search%","%$search%","%$search%");
1806 $query .= ' AND biblioitems.ean = ?';
1809 if ( $booksellerid ) {
1810 $query .= 'AND aqbasket.booksellerid = ?';
1811 push @args, $booksellerid;
1814 $query .= 'AND aqbasket.basketno = ?';
1815 push @args, $basketno;
1818 $query .= 'AND aqbasket.basketname LIKE ?';
1819 push @args, "%$basketname%";
1821 if( $basketgroupname ) {
1822 $query .= ' AND aqbasketgroups.name LIKE ?';
1823 push @args, "%$basketgroupname%";
1827 $query .= ' AND aqbasket.authorisedby=? ';
1828 push @args, $userenv->{'number'};
1832 $query .= ' AND aqorders.budget_id = ?';
1833 push @args, $budget_id;
1836 $query .= ' ORDER BY aqbasket.basketno';
1838 my $sth = $dbh->prepare($query);
1839 $sth->execute(@args);
1840 return $sth->fetchall_arrayref({});
1843 #------------------------------------------------------------#
1845 =head3 TransferOrder
1847 my $newordernumber = TransferOrder($ordernumber, $basketno);
1849 Transfer an order line to a basket.
1850 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1851 to BOOKSELLER on DATE' and create new order with internal note
1852 'Transferred from BOOKSELLER on DATE'.
1853 Move all attached items to the new order.
1854 Received orders cannot be transferred.
1855 Return the ordernumber of created order.
1860 my ($ordernumber, $basketno) = @_;
1862 return unless ($ordernumber and $basketno);
1864 my $order = Koha::Acquisition::Orders->find( $ordernumber ) or return;
1865 return if $order->datereceived;
1867 $order = $order->unblessed;
1869 my $basket = GetBasket($basketno);
1870 return unless $basket;
1872 my $dbh = C4::Context->dbh;
1873 my ($query, $sth, $rv);
1877 SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1878 WHERE ordernumber = ?
1880 $sth = $dbh->prepare($query);
1881 $rv = $sth->execute('cancelled', $ordernumber);
1883 delete $order->{'ordernumber'};
1884 delete $order->{parent_ordernumber};
1885 $order->{'basketno'} = $basketno;
1887 my $newordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber;
1890 UPDATE aqorders_items
1892 WHERE ordernumber = ?
1894 $sth = $dbh->prepare($query);
1895 $sth->execute($newordernumber, $ordernumber);
1898 INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1901 $sth = $dbh->prepare($query);
1902 $sth->execute($ordernumber, $newordernumber);
1904 return $newordernumber;
1907 =head3 get_rounding_sql
1909 $rounding_sql = get_rounding_sql($column_name);
1911 returns the correct SQL routine based on OrderPriceRounding system preference.
1915 sub get_rounding_sql {
1916 my ( $round_string ) = @_;
1917 my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
1918 if ( $rounding_pref eq "nearest_cent" ) {
1919 return "CAST($round_string*100 AS SIGNED)/100";
1921 return $round_string;
1924 =head3 get_rounded_price
1926 $rounded_price = get_rounded_price( $price );
1928 returns a price rounded as specified in OrderPriceRounding system preference.
1932 sub get_rounded_price {
1934 my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
1935 if( $rounding_pref eq 'nearest_cent' ) {
1936 return Koha::Number::Price->new( $price )->round();
1942 =head2 FUNCTIONS ABOUT PARCELS
1946 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1948 get a lists of parcels.
1955 is the bookseller this function has to get parcels.
1958 To know on what criteria the results list has to be ordered.
1961 is the booksellerinvoicenumber.
1963 =item $datefrom & $dateto
1964 to know on what date this function has to filter its search.
1969 a pointer on a hash list containing parcel informations as such :
1975 =item Last operation
1977 =item Number of biblio
1979 =item Number of items
1986 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1987 my $dbh = C4::Context->dbh;
1988 my @query_params = ();
1990 SELECT aqinvoices.invoicenumber,
1991 datereceived,purchaseordernumber,
1992 count(DISTINCT biblionumber) AS biblio,
1993 sum(quantity) AS itemsexpected,
1994 sum(quantityreceived) AS itemsreceived
1995 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1996 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1997 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1999 push @query_params, $bookseller;
2001 if ( defined $code ) {
2002 $strsth .= ' and aqinvoices.invoicenumber like ? ';
2003 # add a % to the end of the code to allow stemming.
2004 push @query_params, "$code%";
2007 if ( defined $datefrom ) {
2008 $strsth .= ' and datereceived >= ? ';
2009 push @query_params, $datefrom;
2012 if ( defined $dateto ) {
2013 $strsth .= 'and datereceived <= ? ';
2014 push @query_params, $dateto;
2017 $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
2019 # can't use a placeholder to place this column name.
2020 # but, we could probably be checking to make sure it is a column that will be fetched.
2021 $strsth .= "order by $order " if ($order);
2023 my $sth = $dbh->prepare($strsth);
2025 $sth->execute( @query_params );
2026 my $results = $sth->fetchall_arrayref({});
2030 #------------------------------------------------------------#
2034 \@order_loop = GetHistory( %params );
2036 Retreives some acquisition history information
2046 basket - search both basket name and number
2047 booksellerinvoicenumber
2050 orderstatus (note that orderstatus '' will retrieve orders
2051 of any status except cancelled)
2055 get_canceled_order (if set to a true value, cancelled orders will
2059 $order_loop is a list of hashrefs that each look like this:
2061 'author' => 'Twain, Mark',
2063 'biblionumber' => '215',
2065 'creationdate' => 'MM/DD/YYYY',
2066 'datereceived' => undef,
2069 'invoicenumber' => undef,
2071 'ordernumber' => '1',
2073 'quantityreceived' => undef,
2074 'title' => 'The Adventures of Huckleberry Finn',
2075 'managing_library' => 'CPL'
2076 'is_standing' => '1'
2082 # don't run the query if there are no parameters (list would be too long for sure !)
2083 croak "No search params" unless @_;
2085 my $title = $params{title};
2086 my $author = $params{author};
2087 my $isbn = $params{isbn};
2088 my $ean = $params{ean};
2089 my $name = $params{name};
2090 my $internalnote = $params{internalnote};
2091 my $vendornote = $params{vendornote};
2092 my $from_placed_on = $params{from_placed_on};
2093 my $to_placed_on = $params{to_placed_on};
2094 my $basket = $params{basket};
2095 my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2096 my $basketgroupname = $params{basketgroupname};
2097 my $budget = $params{budget};
2098 my $orderstatus = $params{orderstatus};
2099 my $is_standing = $params{is_standing};
2100 my $biblionumber = $params{biblionumber};
2101 my $get_canceled_order = $params{get_canceled_order} || 0;
2102 my $ordernumber = $params{ordernumber};
2103 my $search_children_too = $params{search_children_too} || 0;
2104 my $created_by = $params{created_by} || [];
2105 my $managing_library = $params{managing_library};
2106 my $ordernumbers = $params{ordernumbers} || [];
2107 my $additional_fields = $params{additional_fields} // [];
2110 my $total_qtyreceived = 0;
2111 my $total_price = 0;
2113 #get variation of isbn
2117 if ( C4::Context->preference("SearchWithISBNVariations") ){
2118 @isbns = C4::Koha::GetVariationsOfISBN( $isbn );
2119 foreach my $isb (@isbns){
2120 push @isbn_params, '?';
2125 push @isbn_params, '?';
2129 my $dbh = C4::Context->dbh;
2132 COALESCE(biblio.title, deletedbiblio.title) AS title,
2133 COALESCE(biblio.author, deletedbiblio.author) AS author,
2134 COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2135 COALESCE(biblioitems.ean, deletedbiblioitems.ean) AS ean,
2137 aqbasket.basketname,
2138 aqbasket.basketgroupid,
2139 aqbasket.authorisedby,
2140 aqbasket.is_standing,
2141 concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2142 branch as managing_library,
2143 aqbasketgroups.name as groupname,
2145 aqbasket.creationdate,
2146 aqorders.datereceived,
2148 aqorders.quantityreceived,
2150 aqorders.ordernumber,
2152 aqinvoices.invoicenumber,
2153 aqbooksellers.id as id,
2154 aqorders.biblionumber,
2155 aqorders.orderstatus,
2156 aqorders.parent_ordernumber,
2157 aqorders.order_internalnote,
2158 aqorders.order_vendornote,
2159 aqbudgets.budget_name
2161 $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2164 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2165 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2166 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2167 LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2168 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2169 LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2170 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2171 LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2172 LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2173 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2176 $query .= " WHERE 1 ";
2178 unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2179 $query .= " AND datecancellationprinted IS NULL ";
2182 my @query_params = ();
2184 if ( $biblionumber ) {
2185 $query .= " AND biblio.biblionumber = ?";
2186 push @query_params, $biblionumber;
2190 $query .= " AND biblio.title LIKE ? ";
2191 $title =~ s/\s+/%/g;
2192 push @query_params, "%$title%";
2196 $query .= " AND biblio.author LIKE ? ";
2197 push @query_params, "%$author%";
2201 $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2202 foreach my $isb (@isbns){
2203 push @query_params, "%$isb%";
2208 $query .= " AND biblioitems.ean = ? ";
2209 push @query_params, "$ean";
2212 $query .= " AND aqbooksellers.name LIKE ? ";
2213 push @query_params, "%$name%";
2217 $query .= " AND aqbudgets.budget_id = ? ";
2218 push @query_params, "$budget";
2221 if ( $from_placed_on ) {
2222 $query .= " AND creationdate >= ? ";
2223 push @query_params, $from_placed_on;
2226 if ( $to_placed_on ) {
2227 $query .= " AND creationdate <= ? ";
2228 push @query_params, $to_placed_on;
2231 if ( defined $orderstatus and $orderstatus ne '') {
2232 $query .= " AND aqorders.orderstatus = ? ";
2233 push @query_params, "$orderstatus";
2236 if ( $is_standing ) {
2237 $query .= " AND is_standing = ? ";
2238 push @query_params, $is_standing;
2242 if ($basket =~ m/^\d+$/) {
2243 $query .= " AND aqorders.basketno = ? ";
2244 push @query_params, $basket;
2246 $query .= " AND aqbasket.basketname LIKE ? ";
2247 push @query_params, "%$basket%";
2251 if ( $internalnote ) {
2252 $query .= " AND aqorders.order_internalnote LIKE ? ";
2253 push @query_params, "%$internalnote%";
2256 if ( $vendornote ) {
2257 $query .= " AND aqorders.order_vendornote LIKE ?";
2258 push @query_params, "%$vendornote%";
2261 if ($booksellerinvoicenumber) {
2262 $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2263 push @query_params, "%$booksellerinvoicenumber%";
2266 if ($basketgroupname) {
2267 $query .= " AND aqbasketgroups.name LIKE ? ";
2268 push @query_params, "%$basketgroupname%";
2272 $query .= " AND (aqorders.ordernumber = ? ";
2273 push @query_params, $ordernumber;
2274 if ($search_children_too) {
2275 $query .= " OR aqorders.parent_ordernumber = ? ";
2276 push @query_params, $ordernumber;
2281 if ( @$created_by ) {
2282 $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2283 push @query_params, @$created_by;
2286 if ( $managing_library ) {
2287 $query .= " AND aqbasket.branch = ? ";
2288 push @query_params, $managing_library;
2291 if ( @$ordernumbers ) {
2292 $query .= ' AND (aqorders.ordernumber IN ( ' . join (',', ('?') x @$ordernumbers ) . '))';
2293 push @query_params, @$ordernumbers;
2295 if ( @$additional_fields ) {
2296 my @baskets = Koha::Acquisition::Baskets->filter_by_additional_fields($additional_fields)->as_list;
2298 return [] unless @baskets;
2300 # No parameterization because record IDs come directly from DB
2301 $query .= ' AND aqbasket.basketno IN ( ' . join( ',', map { $_->basketno } @baskets ) . ' )';
2304 if ( C4::Context->preference("IndependentBranches") ) {
2305 unless ( C4::Context->IsSuperLibrarian() ) {
2306 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2307 push @query_params, C4::Context->userenv->{branch};
2310 $query .= " ORDER BY id";
2312 return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2315 =head2 GetRecentAcqui
2317 $results = GetRecentAcqui($days);
2319 C<$results> is a ref to a table which contains hashref
2323 sub GetRecentAcqui {
2325 my $dbh = C4::Context->dbh;
2329 ORDER BY timestamp DESC
2332 my $sth = $dbh->prepare($query);
2334 my $results = $sth->fetchall_arrayref({});
2338 #------------------------------------------------------------#
2342 &AddClaim($ordernumber);
2344 Add a claim for an order
2349 my ($ordernumber) = @_;
2350 my $dbh = C4::Context->dbh;
2353 claims_count = claims_count + 1,
2354 claimed_date = CURDATE()
2355 WHERE ordernumber = ?
2357 my $sth = $dbh->prepare($query);
2358 $sth->execute($ordernumber);
2363 my @invoices = GetInvoices(
2364 invoicenumber => $invoicenumber,
2365 supplierid => $supplierid,
2366 suppliername => $suppliername,
2367 shipmentdatefrom => $shipmentdatefrom, # ISO format
2368 shipmentdateto => $shipmentdateto, # ISO format
2369 billingdatefrom => $billingdatefrom, # ISO format
2370 billingdateto => $billingdateto, # ISO format
2371 isbneanissn => $isbn_or_ean_or_issn,
2374 publisher => $publisher,
2375 publicationyear => $publicationyear,
2376 branchcode => $branchcode,
2377 order_by => $order_by
2380 Return a list of invoices that match all given criteria.
2382 $order_by is "column_name (asc|desc)", where column_name is any of
2383 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2384 'shipmentcost', 'shipmentcost_budgetid'.
2386 asc is the default if omitted
2393 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2394 closedate shipmentcost shipmentcost_budgetid);
2396 my $dbh = C4::Context->dbh;
2398 SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
2399 aqbooksellers.name AS suppliername,
2402 aqorders.datereceived IS NOT NULL,
2403 aqorders.biblionumber,
2406 ) AS receivedbiblios,
2409 aqorders.subscriptionid IS NOT NULL,
2410 aqorders.subscriptionid,
2413 ) AS is_linked_to_subscriptions,
2414 SUM(aqorders.quantityreceived) AS receiveditems
2416 LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2417 LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2418 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2419 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2420 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2421 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2422 LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2427 if($args{supplierid}) {
2428 push @bind_strs, " aqinvoices.booksellerid = ? ";
2429 push @bind_args, $args{supplierid};
2431 if($args{invoicenumber}) {
2432 push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2433 push @bind_args, "%$args{invoicenumber}%";
2435 if($args{suppliername}) {
2436 push @bind_strs, " aqbooksellers.name LIKE ? ";
2437 push @bind_args, "%$args{suppliername}%";
2439 if($args{shipmentdatefrom}) {
2440 push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2441 push @bind_args, $args{shipmentdatefrom};
2443 if($args{shipmentdateto}) {
2444 push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2445 push @bind_args, $args{shipmentdateto};
2447 if($args{billingdatefrom}) {
2448 push @bind_strs, " aqinvoices.billingdate >= ? ";
2449 push @bind_args, $args{billingdatefrom};
2451 if($args{billingdateto}) {
2452 push @bind_strs, " aqinvoices.billingdate <= ? ";
2453 push @bind_args, $args{billingdateto};
2455 if($args{isbneanissn}) {
2456 push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2457 push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2460 push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2461 push @bind_args, $args{title};
2464 push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2465 push @bind_args, $args{author};
2467 if($args{publisher}) {
2468 push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2469 push @bind_args, $args{publisher};
2471 if($args{publicationyear}) {
2472 push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2473 push @bind_args, $args{publicationyear}, $args{publicationyear};
2475 if($args{branchcode}) {
2476 push @bind_strs, " borrowers.branchcode = ? ";
2477 push @bind_args, $args{branchcode};
2479 if($args{message_id}) {
2480 push @bind_strs, " aqinvoices.message_id = ? ";
2481 push @bind_args, $args{message_id};
2484 $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2485 $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";
2487 if($args{order_by}) {
2488 my ($column, $direction) = split / /, $args{order_by};
2489 if(grep { $_ eq $column } @columns) {
2490 $direction ||= 'ASC';
2491 $query .= " ORDER BY $column $direction";
2495 my $sth = $dbh->prepare($query);
2496 $sth->execute(@bind_args);
2498 my $results = $sth->fetchall_arrayref({});
2504 my $invoice = GetInvoice($invoiceid);
2506 Get informations about invoice with given $invoiceid
2508 Return a hash filled with aqinvoices.* fields
2513 my ($invoiceid) = @_;
2516 return unless $invoiceid;
2518 my $dbh = C4::Context->dbh;
2524 my $sth = $dbh->prepare($query);
2525 $sth->execute($invoiceid);
2527 $invoice = $sth->fetchrow_hashref;
2531 =head3 GetInvoiceDetails
2533 my $invoice = GetInvoiceDetails($invoiceid)
2535 Return informations about an invoice + the list of related order lines
2537 Orders informations are in $invoice->{orders} (array ref)
2541 sub GetInvoiceDetails {
2542 my ($invoiceid) = @_;
2544 if ( !defined $invoiceid ) {
2545 carp 'GetInvoiceDetails called without an invoiceid';
2549 my $dbh = C4::Context->dbh;
2551 SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2553 LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2556 my $sth = $dbh->prepare($query);
2557 $sth->execute($invoiceid);
2559 my $invoice = $sth->fetchrow_hashref;
2564 biblio.copyrightdate,
2566 biblioitems.publishercode,
2567 biblioitems.publicationyear,
2568 aqbasket.basketname,
2569 aqbasketgroups.id AS basketgroupid,
2570 aqbasketgroups.name AS basketgroupname
2572 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2573 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2574 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2575 LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2578 $sth = $dbh->prepare($query);
2579 $sth->execute($invoiceid);
2580 $invoice->{orders} = $sth->fetchall_arrayref({});
2581 $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2588 my $invoiceid = AddInvoice(
2589 invoicenumber => $invoicenumber,
2590 booksellerid => $booksellerid,
2591 shipmentdate => $shipmentdate,
2592 billingdate => $billingdate,
2593 closedate => $closedate,
2594 shipmentcost => $shipmentcost,
2595 shipmentcost_budgetid => $shipmentcost_budgetid
2598 Create a new invoice and return its id or undef if it fails.
2605 return unless(%invoice and $invoice{invoicenumber});
2607 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2608 closedate shipmentcost shipmentcost_budgetid message_id);
2612 foreach my $key (keys %invoice) {
2613 if(0 < grep { $_ eq $key } @columns) {
2614 push @set_strs, "$key = ?";
2615 push @set_args, ($invoice{$key} || undef);
2621 my $dbh = C4::Context->dbh;
2622 my $query = "INSERT INTO aqinvoices SET ";
2623 $query .= join (",", @set_strs);
2624 my $sth = $dbh->prepare($query);
2625 $rv = $sth->execute(@set_args);
2627 $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2636 invoiceid => $invoiceid, # Mandatory
2637 invoicenumber => $invoicenumber,
2638 booksellerid => $booksellerid,
2639 shipmentdate => $shipmentdate,
2640 billingdate => $billingdate,
2641 closedate => $closedate,
2642 shipmentcost => $shipmentcost,
2643 shipmentcost_budgetid => $shipmentcost_budgetid
2646 Modify an invoice, invoiceid is mandatory.
2648 Return undef if it fails.
2655 return unless(%invoice and $invoice{invoiceid});
2657 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2658 closedate shipmentcost shipmentcost_budgetid);
2662 foreach my $key (keys %invoice) {
2663 if(0 < grep { $_ eq $key } @columns) {
2664 push @set_strs, "$key = ?";
2665 push @set_args, ($invoice{$key} || undef);
2669 my $dbh = C4::Context->dbh;
2670 my $query = "UPDATE aqinvoices SET ";
2671 $query .= join(",", @set_strs);
2672 $query .= " WHERE invoiceid = ?";
2674 my $sth = $dbh->prepare($query);
2675 $sth->execute(@set_args, $invoice{invoiceid});
2680 CloseInvoice($invoiceid);
2684 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2689 my ($invoiceid) = @_;
2691 return unless $invoiceid;
2693 my $dbh = C4::Context->dbh;
2696 SET closedate = CAST(NOW() AS DATE)
2699 my $sth = $dbh->prepare($query);
2700 $sth->execute($invoiceid);
2703 =head3 ReopenInvoice
2705 ReopenInvoice($invoiceid);
2709 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2714 my ($invoiceid) = @_;
2716 return unless $invoiceid;
2718 my $dbh = C4::Context->dbh;
2721 SET closedate = NULL
2724 my $sth = $dbh->prepare($query);
2725 $sth->execute($invoiceid);
2730 DelInvoice($invoiceid);
2732 Delete an invoice if there are no items attached to it.
2737 my ($invoiceid) = @_;
2739 return unless $invoiceid;
2741 my $dbh = C4::Context->dbh;
2747 my $sth = $dbh->prepare($query);
2748 $sth->execute($invoiceid);
2749 my $res = $sth->fetchrow_arrayref;
2750 if ( $res && $res->[0] == 0 ) {
2752 DELETE FROM aqinvoices
2755 my $sth = $dbh->prepare($query);
2756 return ( $sth->execute($invoiceid) > 0 );
2761 =head3 MergeInvoices
2763 MergeInvoices($invoiceid, \@sourceids);
2765 Merge the invoices identified by the IDs in \@sourceids into
2766 the invoice identified by $invoiceid.
2771 my ($invoiceid, $sourceids) = @_;
2773 return unless $invoiceid;
2774 foreach my $sourceid (@$sourceids) {
2775 next if $sourceid == $invoiceid;
2776 my $source = GetInvoiceDetails($sourceid);
2777 foreach my $order (@{$source->{'orders'}}) {
2778 $order->{'invoiceid'} = $invoiceid;
2781 DelInvoice($source->{'invoiceid'});
2786 =head3 GetBiblioCountByBasketno
2788 $biblio_count = &GetBiblioCountByBasketno($basketno);
2790 Looks up the biblio's count that has basketno value $basketno
2796 sub GetBiblioCountByBasketno {
2797 my ($basketno) = @_;
2798 my $dbh = C4::Context->dbh;
2800 SELECT COUNT( DISTINCT( biblionumber ) )
2803 AND datecancellationprinted IS NULL
2806 my $sth = $dbh->prepare($query);
2807 $sth->execute($basketno);
2808 return $sth->fetchrow;
2811 =head3 populate_order_with_prices
2813 $order = populate_order_with_prices({
2814 order => $order #a hashref with the order values
2815 booksellerid => $booksellerid #FIXME - should obtain from order basket
2816 receiving => 1 # boolean representing order stage, should pass only this or ordering
2817 ordering => 1 # boolean representing order stage
2821 Sets calculated values for an order - all values are stored with full precision
2822 regardless of rounding preference except for tax value which is calculated
2823 on rounded values if requested
2825 For ordering the values set are:
2830 tax_value_on_ordering
2831 For receiving the value set are:
2832 unitprice_tax_included
2833 unitprice_tax_excluded
2834 tax_value_on_receiving
2836 Note: When receiving, if the rounded value of the unitprice matches the rounded
2837 value of the ecost then then ecost (full precision) is used.
2839 Returns a hashref of the order
2841 FIXME: Move this to Koha::Acquisition::Order.pm
2845 sub populate_order_with_prices {
2848 my $order = $params->{order};
2849 my $booksellerid = $params->{booksellerid};
2850 return unless $booksellerid;
2852 my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
2854 my $receiving = $params->{receiving};
2855 my $ordering = $params->{ordering};
2856 my $discount = $order->{discount};
2857 $discount /= 100 if $discount > 1;
2860 $order->{tax_rate_on_ordering} //= $order->{tax_rate};
2861 if ( $bookseller->listincgst ) {
2863 # The user entered the prices tax included
2864 $order->{unitprice} += 0;
2865 $order->{unitprice_tax_included} = $order->{unitprice};
2866 $order->{rrp_tax_included} = $order->{rrp};
2868 # price tax excluded = price tax included / ( 1 + tax rate )
2869 $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2870 $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2872 # ecost tax included = rrp tax included ( 1 - discount )
2873 $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
2875 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2876 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2878 # tax value = quantity * ecost tax excluded * tax rate
2879 # we should use the unitprice if included
2880 my $cost_tax_included = $order->{unitprice_tax_included} == 0 ? $order->{ecost_tax_included} : $order->{unitprice_tax_included};
2881 my $cost_tax_excluded = $order->{unitprice_tax_excluded} == 0 ? $order->{ecost_tax_excluded} : $order->{unitprice_tax_excluded};
2882 $order->{tax_value_on_ordering} = ( get_rounded_price($cost_tax_included) - get_rounded_price($cost_tax_excluded) ) * $order->{quantity};
2886 # The user entered the prices tax excluded
2887 $order->{unitprice_tax_excluded} = $order->{unitprice};
2888 $order->{rrp_tax_excluded} = $order->{rrp};
2890 # price tax included = price tax excluded * ( 1 - tax rate )
2891 $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2892 $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2894 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2895 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2897 # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount ) = ecost tax excluded * ( 1 + tax rate )
2898 $order->{ecost_tax_included} = $order->{ecost_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2900 # tax value = quantity * ecost tax included * tax rate
2901 # we should use the unitprice if included
2902 my $cost_tax_excluded = $order->{unitprice_tax_excluded} == 0 ? $order->{ecost_tax_excluded} : $order->{unitprice_tax_excluded};
2903 $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($cost_tax_excluded) * $order->{tax_rate_on_ordering};
2908 $order->{tax_rate_on_receiving} //= $order->{tax_rate};
2909 if ( $bookseller->invoiceincgst ) {
2910 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2911 # we need to keep the exact ecost value
2912 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
2913 $order->{unitprice} = $order->{ecost_tax_included};
2916 # The user entered the unit price tax included
2917 $order->{unitprice_tax_included} = $order->{unitprice};
2919 # unit price tax excluded = unit price tax included / ( 1 + tax rate )
2920 $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
2923 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2924 # we need to keep the exact ecost value
2925 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
2926 $order->{unitprice} = $order->{ecost_tax_excluded};
2929 # The user entered the unit price tax excluded
2930 $order->{unitprice_tax_excluded} = $order->{unitprice};
2933 # unit price tax included = unit price tax included * ( 1 + tax rate )
2934 $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
2937 # tax value = quantity * unit price tax excluded * tax rate
2938 $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
2944 =head3 GetOrderUsers
2946 $order_users_ids = &GetOrderUsers($ordernumber);
2948 Returns a list of all borrowernumbers that are in order users list
2953 my ($ordernumber) = @_;
2955 return unless $ordernumber;
2958 SELECT borrowernumber
2960 WHERE ordernumber = ?
2962 my $dbh = C4::Context->dbh;
2963 my $sth = $dbh->prepare($query);
2964 $sth->execute($ordernumber);
2965 my $results = $sth->fetchall_arrayref( {} );
2967 my @borrowernumbers;
2968 foreach (@$results) {
2969 push @borrowernumbers, $_->{'borrowernumber'};
2972 return @borrowernumbers;
2975 =head3 ModOrderUsers
2977 my @order_users_ids = (1, 2, 3);
2978 &ModOrderUsers($ordernumber, @basketusers_ids);
2980 Delete all users from order users list, and add users in C<@order_users_ids>
2986 my ( $ordernumber, @order_users_ids ) = @_;
2988 return unless $ordernumber;
2990 my $dbh = C4::Context->dbh;
2992 DELETE FROM aqorder_users
2993 WHERE ordernumber = ?
2995 my $sth = $dbh->prepare($query);
2996 $sth->execute($ordernumber);
2999 INSERT INTO aqorder_users (ordernumber, borrowernumber)
3002 $sth = $dbh->prepare($query);
3003 foreach my $order_user_id (@order_users_ids) {
3004 $sth->execute( $ordernumber, $order_user_id );
3008 sub NotifyOrderUsers {
3009 my ($ordernumber) = @_;
3011 my @borrowernumbers = GetOrderUsers($ordernumber);
3012 return unless @borrowernumbers;
3014 my $order = GetOrder( $ordernumber );
3015 for my $borrowernumber (@borrowernumbers) {
3016 my $patron = Koha::Patrons->find( $borrowernumber );
3017 my $library = $patron->library->unblessed;
3018 my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed;
3019 my $letter = C4::Letters::GetPreparedLetter(
3020 module => 'acquisition',
3021 letter_code => 'ACQ_NOTIF_ON_RECEIV',
3022 branchcode => $library->{branchcode},
3023 lang => $patron->lang,
3025 'branches' => $library,
3026 'borrowers' => $patron->unblessed,
3027 'biblio' => $biblio,
3028 'aqorders' => $order,
3032 C4::Letters::EnqueueLetter(
3035 borrowernumber => $borrowernumber,
3036 LibraryName => C4::Context->preference("LibraryName"),
3037 message_transport_type => 'email',
3039 ) or warn "can't enqueue letter $letter";
3044 =head3 FillWithDefaultValues
3046 FillWithDefaultValues( $marc_record, $params );
3048 This will update the record with default value defined in the ACQ framework.
3049 For all existing fields, if a default value exists and there are no subfield, it will be created.
3050 If the field does not exist, it will be created too.
3052 If the parameter only_mandatory => 1 is passed via $params, only the mandatory
3053 defaults are being applied to the record.
3057 sub FillWithDefaultValues {
3058 my ( $record, $params ) = @_;
3059 my $mandatory = $params->{only_mandatory};
3060 my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3063 C4::Biblio::GetMarcFromKohaField( 'items.itemnumber' );
3064 for my $tag ( sort keys %$tagslib ) {
3066 next if $tag == $itemfield;
3067 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3068 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3069 next if $mandatory && !$tagslib->{$tag}{$subfield}{mandatory};
3070 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3071 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3072 my @fields = $record->field($tag);
3074 for my $field (@fields) {
3075 if ( $field->is_control_field ) {
3076 $field->update($defaultvalue) if not defined $field->data;
3078 elsif ( not defined $field->subfield($subfield) ) {
3079 $field->add_subfields(
3080 $subfield => $defaultvalue );
3085 if ( $tag < 10 ) { # is_control_field
3086 $record->insert_fields_ordered(
3093 $record->insert_fields_ordered(
3095 $tag, '', '', $subfield => $defaultvalue
3111 Koha Development Team <http://koha-community.org/>