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 $issn = $params{issn};
2089 my $ean = $params{ean};
2090 my $name = $params{name};
2091 my $internalnote = $params{internalnote};
2092 my $vendornote = $params{vendornote};
2093 my $from_placed_on = $params{from_placed_on};
2094 my $to_placed_on = $params{to_placed_on};
2095 my $basket = $params{basket};
2096 my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2097 my $basketgroupname = $params{basketgroupname};
2098 my $budget = $params{budget};
2099 my $orderstatus = $params{orderstatus};
2100 my $is_standing = $params{is_standing};
2101 my $biblionumber = $params{biblionumber};
2102 my $get_canceled_order = $params{get_canceled_order} || 0;
2103 my $ordernumber = $params{ordernumber};
2104 my $search_children_too = $params{search_children_too} || 0;
2105 my $created_by = $params{created_by} || [];
2106 my $managing_library = $params{managing_library};
2107 my $ordernumbers = $params{ordernumbers} || [];
2108 my $additional_fields = $params{additional_fields} // [];
2111 my $total_qtyreceived = 0;
2112 my $total_price = 0;
2114 #get variation of isbn
2118 if ( C4::Context->preference("SearchWithISBNVariations") ){
2119 @isbns = C4::Koha::GetVariationsOfISBN( $isbn );
2120 foreach my $isb (@isbns){
2121 push @isbn_params, '?';
2126 push @isbn_params, '?';
2130 #get variation of issn
2134 if ( C4::Context->preference("SearchWithISSNVariations") ){
2135 @issns = C4::Koha::GetVariationsOfISSN( $issn );
2136 push @issn_params, ('?') x @issns;
2140 push @issn_params, '?';
2144 my $dbh = C4::Context->dbh;
2147 COALESCE(biblio.title, deletedbiblio.title) AS title,
2148 COALESCE(biblio.author, deletedbiblio.author) AS author,
2149 COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2150 COALESCE(biblioitems.ean, deletedbiblioitems.ean) AS ean,
2152 aqbasket.basketname,
2153 aqbasket.basketgroupid,
2154 aqbasket.authorisedby,
2155 aqbasket.is_standing,
2156 concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2157 branch as managing_library,
2158 aqbasketgroups.name as groupname,
2160 aqbasket.creationdate,
2161 aqorders.datereceived,
2163 aqorders.quantityreceived,
2165 aqorders.ordernumber,
2167 aqinvoices.invoicenumber,
2168 aqbooksellers.id as id,
2169 aqorders.biblionumber,
2170 aqorders.orderstatus,
2171 aqorders.parent_ordernumber,
2172 aqorders.order_internalnote,
2173 aqorders.order_vendornote,
2174 aqbudgets.budget_name
2176 $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2179 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2180 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2181 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2182 LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2183 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2184 LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2185 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2186 LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2187 LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2188 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2191 $query .= " WHERE 1 ";
2193 unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2194 $query .= " AND datecancellationprinted IS NULL ";
2197 my @query_params = ();
2199 if ( $biblionumber ) {
2200 $query .= " AND biblio.biblionumber = ?";
2201 push @query_params, $biblionumber;
2205 $query .= " AND biblio.title LIKE ? ";
2206 $title =~ s/\s+/%/g;
2207 push @query_params, "%$title%";
2211 $query .= " AND biblio.author LIKE ? ";
2212 push @query_params, "%$author%";
2216 $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2217 foreach my $isb (@isbns){
2218 push @query_params, "%$isb%";
2223 $query .= " AND ( biblioitems.issn LIKE " . join (" OR biblioitems.issn LIKE ", @issn_params ) . ")";
2224 foreach my $isn (@issns){
2225 push @query_params, "%$isn%";
2230 $query .= " AND biblioitems.ean = ? ";
2231 push @query_params, "$ean";
2234 $query .= " AND aqbooksellers.name LIKE ? ";
2235 push @query_params, "%$name%";
2239 $query .= " AND aqbudgets.budget_id = ? ";
2240 push @query_params, "$budget";
2243 if ( $from_placed_on ) {
2244 $query .= " AND creationdate >= ? ";
2245 push @query_params, $from_placed_on;
2248 if ( $to_placed_on ) {
2249 $query .= " AND creationdate <= ? ";
2250 push @query_params, $to_placed_on;
2253 if ( defined $orderstatus and $orderstatus ne '') {
2254 $query .= " AND aqorders.orderstatus = ? ";
2255 push @query_params, "$orderstatus";
2258 if ( $is_standing ) {
2259 $query .= " AND is_standing = ? ";
2260 push @query_params, $is_standing;
2264 if ($basket =~ m/^\d+$/) {
2265 $query .= " AND aqorders.basketno = ? ";
2266 push @query_params, $basket;
2268 $query .= " AND aqbasket.basketname LIKE ? ";
2269 push @query_params, "%$basket%";
2273 if ( $internalnote ) {
2274 $query .= " AND aqorders.order_internalnote LIKE ? ";
2275 push @query_params, "%$internalnote%";
2278 if ( $vendornote ) {
2279 $query .= " AND aqorders.order_vendornote LIKE ?";
2280 push @query_params, "%$vendornote%";
2283 if ($booksellerinvoicenumber) {
2284 $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2285 push @query_params, "%$booksellerinvoicenumber%";
2288 if ($basketgroupname) {
2289 $query .= " AND aqbasketgroups.name LIKE ? ";
2290 push @query_params, "%$basketgroupname%";
2294 $query .= " AND (aqorders.ordernumber = ? ";
2295 push @query_params, $ordernumber;
2296 if ($search_children_too) {
2297 $query .= " OR aqorders.parent_ordernumber = ? ";
2298 push @query_params, $ordernumber;
2303 if ( @$created_by ) {
2304 $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2305 push @query_params, @$created_by;
2308 if ( $managing_library ) {
2309 $query .= " AND aqbasket.branch = ? ";
2310 push @query_params, $managing_library;
2313 if ( @$ordernumbers ) {
2314 $query .= ' AND (aqorders.ordernumber IN ( ' . join (',', ('?') x @$ordernumbers ) . '))';
2315 push @query_params, @$ordernumbers;
2317 if ( @$additional_fields ) {
2318 my @baskets = Koha::Acquisition::Baskets->filter_by_additional_fields($additional_fields)->as_list;
2320 return [] unless @baskets;
2322 # No parameterization because record IDs come directly from DB
2323 $query .= ' AND aqbasket.basketno IN ( ' . join( ',', map { $_->basketno } @baskets ) . ' )';
2326 if ( C4::Context->preference("IndependentBranches") ) {
2327 unless ( C4::Context->IsSuperLibrarian() ) {
2328 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2329 push @query_params, C4::Context->userenv->{branch};
2332 $query .= " ORDER BY id";
2334 return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2337 =head2 GetRecentAcqui
2339 $results = GetRecentAcqui($days);
2341 C<$results> is a ref to a table which contains hashref
2345 sub GetRecentAcqui {
2347 my $dbh = C4::Context->dbh;
2351 ORDER BY timestamp DESC
2354 my $sth = $dbh->prepare($query);
2356 my $results = $sth->fetchall_arrayref({});
2360 #------------------------------------------------------------#
2364 &AddClaim($ordernumber);
2366 Add a claim for an order
2371 my ($ordernumber) = @_;
2372 my $dbh = C4::Context->dbh;
2375 claims_count = claims_count + 1,
2376 claimed_date = CURDATE()
2377 WHERE ordernumber = ?
2379 my $sth = $dbh->prepare($query);
2380 $sth->execute($ordernumber);
2385 my @invoices = GetInvoices(
2386 invoicenumber => $invoicenumber,
2387 supplierid => $supplierid,
2388 suppliername => $suppliername,
2389 shipmentdatefrom => $shipmentdatefrom, # ISO format
2390 shipmentdateto => $shipmentdateto, # ISO format
2391 billingdatefrom => $billingdatefrom, # ISO format
2392 billingdateto => $billingdateto, # ISO format
2393 isbneanissn => $isbn_or_ean_or_issn,
2396 publisher => $publisher,
2397 publicationyear => $publicationyear,
2398 branchcode => $branchcode,
2399 order_by => $order_by
2402 Return a list of invoices that match all given criteria.
2404 $order_by is "column_name (asc|desc)", where column_name is any of
2405 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2406 'shipmentcost', 'shipmentcost_budgetid'.
2408 asc is the default if omitted
2415 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2416 closedate shipmentcost shipmentcost_budgetid);
2418 my $dbh = C4::Context->dbh;
2420 SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
2421 aqbooksellers.name AS suppliername,
2424 aqorders.datereceived IS NOT NULL,
2425 aqorders.biblionumber,
2428 ) AS receivedbiblios,
2431 aqorders.subscriptionid IS NOT NULL,
2432 aqorders.subscriptionid,
2435 ) AS is_linked_to_subscriptions,
2436 SUM(aqorders.quantityreceived) AS receiveditems
2438 LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2439 LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2440 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2441 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2442 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2443 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2444 LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2449 if($args{supplierid}) {
2450 push @bind_strs, " aqinvoices.booksellerid = ? ";
2451 push @bind_args, $args{supplierid};
2453 if($args{invoicenumber}) {
2454 push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2455 push @bind_args, "%$args{invoicenumber}%";
2457 if($args{suppliername}) {
2458 push @bind_strs, " aqbooksellers.name LIKE ? ";
2459 push @bind_args, "%$args{suppliername}%";
2461 if($args{shipmentdatefrom}) {
2462 push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2463 push @bind_args, $args{shipmentdatefrom};
2465 if($args{shipmentdateto}) {
2466 push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2467 push @bind_args, $args{shipmentdateto};
2469 if($args{billingdatefrom}) {
2470 push @bind_strs, " aqinvoices.billingdate >= ? ";
2471 push @bind_args, $args{billingdatefrom};
2473 if($args{billingdateto}) {
2474 push @bind_strs, " aqinvoices.billingdate <= ? ";
2475 push @bind_args, $args{billingdateto};
2477 if($args{isbneanissn}) {
2478 push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2479 push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2482 push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2483 push @bind_args, $args{title};
2486 push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2487 push @bind_args, $args{author};
2489 if($args{publisher}) {
2490 push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2491 push @bind_args, $args{publisher};
2493 if($args{publicationyear}) {
2494 push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2495 push @bind_args, $args{publicationyear}, $args{publicationyear};
2497 if($args{branchcode}) {
2498 push @bind_strs, " borrowers.branchcode = ? ";
2499 push @bind_args, $args{branchcode};
2501 if($args{message_id}) {
2502 push @bind_strs, " aqinvoices.message_id = ? ";
2503 push @bind_args, $args{message_id};
2506 $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2507 $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";
2509 if($args{order_by}) {
2510 my ($column, $direction) = split / /, $args{order_by};
2511 if(grep { $_ eq $column } @columns) {
2512 $direction ||= 'ASC';
2513 $query .= " ORDER BY $column $direction";
2517 my $sth = $dbh->prepare($query);
2518 $sth->execute(@bind_args);
2520 my $results = $sth->fetchall_arrayref({});
2526 my $invoice = GetInvoice($invoiceid);
2528 Get informations about invoice with given $invoiceid
2530 Return a hash filled with aqinvoices.* fields
2535 my ($invoiceid) = @_;
2538 return unless $invoiceid;
2540 my $dbh = C4::Context->dbh;
2546 my $sth = $dbh->prepare($query);
2547 $sth->execute($invoiceid);
2549 $invoice = $sth->fetchrow_hashref;
2553 =head3 GetInvoiceDetails
2555 my $invoice = GetInvoiceDetails($invoiceid)
2557 Return informations about an invoice + the list of related order lines
2559 Orders informations are in $invoice->{orders} (array ref)
2563 sub GetInvoiceDetails {
2564 my ($invoiceid) = @_;
2566 if ( !defined $invoiceid ) {
2567 carp 'GetInvoiceDetails called without an invoiceid';
2571 my $dbh = C4::Context->dbh;
2573 SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2575 LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2578 my $sth = $dbh->prepare($query);
2579 $sth->execute($invoiceid);
2581 my $invoice = $sth->fetchrow_hashref;
2586 biblio.copyrightdate,
2588 biblioitems.publishercode,
2589 biblioitems.publicationyear,
2590 aqbasket.basketname,
2591 aqbasketgroups.id AS basketgroupid,
2592 aqbasketgroups.name AS basketgroupname
2594 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2595 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2596 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2597 LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2600 $sth = $dbh->prepare($query);
2601 $sth->execute($invoiceid);
2602 $invoice->{orders} = $sth->fetchall_arrayref({});
2603 $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2610 my $invoiceid = AddInvoice(
2611 invoicenumber => $invoicenumber,
2612 booksellerid => $booksellerid,
2613 shipmentdate => $shipmentdate,
2614 billingdate => $billingdate,
2615 closedate => $closedate,
2616 shipmentcost => $shipmentcost,
2617 shipmentcost_budgetid => $shipmentcost_budgetid
2620 Create a new invoice and return its id or undef if it fails.
2627 return unless(%invoice and $invoice{invoicenumber});
2629 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2630 closedate shipmentcost shipmentcost_budgetid message_id);
2634 foreach my $key (keys %invoice) {
2635 if(0 < grep { $_ eq $key } @columns) {
2636 push @set_strs, "$key = ?";
2637 push @set_args, ($invoice{$key} || undef);
2643 my $dbh = C4::Context->dbh;
2644 my $query = "INSERT INTO aqinvoices SET ";
2645 $query .= join (",", @set_strs);
2646 my $sth = $dbh->prepare($query);
2647 $rv = $sth->execute(@set_args);
2649 $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2658 invoiceid => $invoiceid, # Mandatory
2659 invoicenumber => $invoicenumber,
2660 booksellerid => $booksellerid,
2661 shipmentdate => $shipmentdate,
2662 billingdate => $billingdate,
2663 closedate => $closedate,
2664 shipmentcost => $shipmentcost,
2665 shipmentcost_budgetid => $shipmentcost_budgetid
2668 Modify an invoice, invoiceid is mandatory.
2670 Return undef if it fails.
2677 return unless(%invoice and $invoice{invoiceid});
2679 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2680 closedate shipmentcost shipmentcost_budgetid);
2684 foreach my $key (keys %invoice) {
2685 if(0 < grep { $_ eq $key } @columns) {
2686 push @set_strs, "$key = ?";
2687 push @set_args, ($invoice{$key} || undef);
2691 my $dbh = C4::Context->dbh;
2692 my $query = "UPDATE aqinvoices SET ";
2693 $query .= join(",", @set_strs);
2694 $query .= " WHERE invoiceid = ?";
2696 my $sth = $dbh->prepare($query);
2697 $sth->execute(@set_args, $invoice{invoiceid});
2702 CloseInvoice($invoiceid);
2706 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2711 my ($invoiceid) = @_;
2713 return unless $invoiceid;
2715 my $dbh = C4::Context->dbh;
2718 SET closedate = CAST(NOW() AS DATE)
2721 my $sth = $dbh->prepare($query);
2722 $sth->execute($invoiceid);
2725 =head3 ReopenInvoice
2727 ReopenInvoice($invoiceid);
2731 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2736 my ($invoiceid) = @_;
2738 return unless $invoiceid;
2740 my $dbh = C4::Context->dbh;
2743 SET closedate = NULL
2746 my $sth = $dbh->prepare($query);
2747 $sth->execute($invoiceid);
2752 DelInvoice($invoiceid);
2754 Delete an invoice if there are no items attached to it.
2759 my ($invoiceid) = @_;
2761 return unless $invoiceid;
2763 my $dbh = C4::Context->dbh;
2769 my $sth = $dbh->prepare($query);
2770 $sth->execute($invoiceid);
2771 my $res = $sth->fetchrow_arrayref;
2772 if ( $res && $res->[0] == 0 ) {
2774 DELETE FROM aqinvoices
2777 my $sth = $dbh->prepare($query);
2778 return ( $sth->execute($invoiceid) > 0 );
2783 =head3 MergeInvoices
2785 MergeInvoices($invoiceid, \@sourceids);
2787 Merge the invoices identified by the IDs in \@sourceids into
2788 the invoice identified by $invoiceid.
2793 my ($invoiceid, $sourceids) = @_;
2795 return unless $invoiceid;
2796 foreach my $sourceid (@$sourceids) {
2797 next if $sourceid == $invoiceid;
2798 my $source = GetInvoiceDetails($sourceid);
2799 foreach my $order (@{$source->{'orders'}}) {
2800 $order->{'invoiceid'} = $invoiceid;
2803 DelInvoice($source->{'invoiceid'});
2808 =head3 GetBiblioCountByBasketno
2810 $biblio_count = &GetBiblioCountByBasketno($basketno);
2812 Looks up the biblio's count that has basketno value $basketno
2818 sub GetBiblioCountByBasketno {
2819 my ($basketno) = @_;
2820 my $dbh = C4::Context->dbh;
2822 SELECT COUNT( DISTINCT( biblionumber ) )
2825 AND datecancellationprinted IS NULL
2828 my $sth = $dbh->prepare($query);
2829 $sth->execute($basketno);
2830 return $sth->fetchrow;
2833 =head3 populate_order_with_prices
2835 $order = populate_order_with_prices({
2836 order => $order #a hashref with the order values
2837 booksellerid => $booksellerid #FIXME - should obtain from order basket
2838 receiving => 1 # boolean representing order stage, should pass only this or ordering
2839 ordering => 1 # boolean representing order stage
2843 Sets calculated values for an order - all values are stored with full precision
2844 regardless of rounding preference except for tax value which is calculated
2845 on rounded values if requested
2847 For ordering the values set are:
2852 tax_value_on_ordering
2853 For receiving the value set are:
2854 unitprice_tax_included
2855 unitprice_tax_excluded
2856 tax_value_on_receiving
2858 Note: When receiving, if the rounded value of the unitprice matches the rounded
2859 value of the ecost then then ecost (full precision) is used.
2861 Returns a hashref of the order
2863 FIXME: Move this to Koha::Acquisition::Order.pm
2867 sub populate_order_with_prices {
2870 my $order = $params->{order};
2871 my $booksellerid = $params->{booksellerid};
2872 return unless $booksellerid;
2874 my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
2876 my $receiving = $params->{receiving};
2877 my $ordering = $params->{ordering};
2878 my $discount = $order->{discount};
2879 $discount /= 100 if $discount > 1;
2882 $order->{tax_rate_on_ordering} //= $order->{tax_rate};
2883 if ( $bookseller->listincgst ) {
2885 # The user entered the prices tax included
2886 $order->{unitprice} += 0;
2887 $order->{unitprice_tax_included} = $order->{unitprice};
2888 $order->{rrp_tax_included} = $order->{rrp};
2890 # price tax excluded = price tax included / ( 1 + tax rate )
2891 $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2892 $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2894 # ecost tax included = rrp tax included ( 1 - discount )
2895 $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
2897 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2898 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2900 # tax value = quantity * ecost tax excluded * tax rate
2901 # we should use the unitprice if included
2902 my $cost_tax_included = $order->{unitprice_tax_included} == 0 ? $order->{ecost_tax_included} : $order->{unitprice_tax_included};
2903 my $cost_tax_excluded = $order->{unitprice_tax_excluded} == 0 ? $order->{ecost_tax_excluded} : $order->{unitprice_tax_excluded};
2904 $order->{tax_value_on_ordering} = ( get_rounded_price($cost_tax_included) - get_rounded_price($cost_tax_excluded) ) * $order->{quantity};
2908 # The user entered the prices tax excluded
2909 $order->{unitprice_tax_excluded} = $order->{unitprice};
2910 $order->{rrp_tax_excluded} = $order->{rrp};
2912 # price tax included = price tax excluded * ( 1 - tax rate )
2913 $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2914 $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2916 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2917 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2919 # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount ) = ecost tax excluded * ( 1 + tax rate )
2920 $order->{ecost_tax_included} = $order->{ecost_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2922 # tax value = quantity * ecost tax included * tax rate
2923 # we should use the unitprice if included
2924 my $cost_tax_excluded = $order->{unitprice_tax_excluded} == 0 ? $order->{ecost_tax_excluded} : $order->{unitprice_tax_excluded};
2925 $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($cost_tax_excluded) * $order->{tax_rate_on_ordering};
2930 $order->{tax_rate_on_receiving} //= $order->{tax_rate};
2931 if ( $bookseller->invoiceincgst ) {
2932 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2933 # we need to keep the exact ecost value
2934 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
2935 $order->{unitprice} = $order->{ecost_tax_included};
2938 # The user entered the unit price tax included
2939 $order->{unitprice_tax_included} = $order->{unitprice};
2941 # unit price tax excluded = unit price tax included / ( 1 + tax rate )
2942 $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
2945 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2946 # we need to keep the exact ecost value
2947 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
2948 $order->{unitprice} = $order->{ecost_tax_excluded};
2951 # The user entered the unit price tax excluded
2952 $order->{unitprice_tax_excluded} = $order->{unitprice};
2955 # unit price tax included = unit price tax included * ( 1 + tax rate )
2956 $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
2959 # tax value = quantity * unit price tax excluded * tax rate
2960 $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
2966 =head3 GetOrderUsers
2968 $order_users_ids = &GetOrderUsers($ordernumber);
2970 Returns a list of all borrowernumbers that are in order users list
2975 my ($ordernumber) = @_;
2977 return unless $ordernumber;
2980 SELECT borrowernumber
2982 WHERE ordernumber = ?
2984 my $dbh = C4::Context->dbh;
2985 my $sth = $dbh->prepare($query);
2986 $sth->execute($ordernumber);
2987 my $results = $sth->fetchall_arrayref( {} );
2989 my @borrowernumbers;
2990 foreach (@$results) {
2991 push @borrowernumbers, $_->{'borrowernumber'};
2994 return @borrowernumbers;
2997 =head3 ModOrderUsers
2999 my @order_users_ids = (1, 2, 3);
3000 &ModOrderUsers($ordernumber, @basketusers_ids);
3002 Delete all users from order users list, and add users in C<@order_users_ids>
3008 my ( $ordernumber, @order_users_ids ) = @_;
3010 return unless $ordernumber;
3012 my $dbh = C4::Context->dbh;
3014 DELETE FROM aqorder_users
3015 WHERE ordernumber = ?
3017 my $sth = $dbh->prepare($query);
3018 $sth->execute($ordernumber);
3021 INSERT INTO aqorder_users (ordernumber, borrowernumber)
3024 $sth = $dbh->prepare($query);
3025 foreach my $order_user_id (@order_users_ids) {
3026 $sth->execute( $ordernumber, $order_user_id );
3030 sub NotifyOrderUsers {
3031 my ($ordernumber) = @_;
3033 my @borrowernumbers = GetOrderUsers($ordernumber);
3034 return unless @borrowernumbers;
3036 my $order = GetOrder( $ordernumber );
3037 for my $borrowernumber (@borrowernumbers) {
3038 my $patron = Koha::Patrons->find( $borrowernumber );
3039 my $library = $patron->library->unblessed;
3040 my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed;
3041 my $letter = C4::Letters::GetPreparedLetter(
3042 module => 'acquisition',
3043 letter_code => 'ACQ_NOTIF_ON_RECEIV',
3044 branchcode => $library->{branchcode},
3045 lang => $patron->lang,
3047 'branches' => $library,
3048 'borrowers' => $patron->unblessed,
3049 'biblio' => $biblio,
3050 'aqorders' => $order,
3054 C4::Letters::EnqueueLetter(
3057 borrowernumber => $borrowernumber,
3058 LibraryName => C4::Context->preference("LibraryName"),
3059 message_transport_type => 'email',
3061 ) or warn "can't enqueue letter $letter";
3066 =head3 FillWithDefaultValues
3068 FillWithDefaultValues( $marc_record, $params );
3070 This will update the record with default value defined in the ACQ framework.
3071 For all existing fields, if a default value exists and there are no subfield, it will be created.
3072 If the field does not exist, it will be created too.
3074 If the parameter only_mandatory => 1 is passed via $params, only the mandatory
3075 defaults are being applied to the record.
3079 sub FillWithDefaultValues {
3080 my ( $record, $params ) = @_;
3081 my $mandatory = $params->{only_mandatory};
3082 my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3085 C4::Biblio::GetMarcFromKohaField( 'items.itemnumber' );
3086 for my $tag ( sort keys %$tagslib ) {
3088 next if $tag == $itemfield;
3089 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3090 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3091 next if $mandatory && !$tagslib->{$tag}{$subfield}{mandatory};
3092 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3093 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3094 my @fields = $record->field($tag);
3096 for my $field (@fields) {
3097 if ( $field->is_control_field ) {
3098 $field->update($defaultvalue) if not defined $field->data;
3100 elsif ( not defined $field->subfield($subfield) ) {
3101 $field->add_subfields(
3102 $subfield => $defaultvalue );
3107 if ( $tag < 10 ) { # is_control_field
3108 $record->insert_fields_ordered(
3115 $record->insert_fields_ordered(
3117 $tag, '', '', $subfield => $defaultvalue
3133 Koha Development Team <http://koha-community.org/>