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} );
327 $biblioitem = $biblio->biblioitem;
330 contractname => $contract->{'contractname'},
331 ordernumber => $order->{'ordernumber'},
332 entrydate => $order->{'entrydate'},
333 isbn => $order->{'isbn'},
334 author => $biblio ? $biblio->author : q{},
335 title => $biblio ? $biblio->title : q{},
336 publicationyear => $biblioitem ? $biblioitem->publicationyear : q{},
337 publishercode => $biblioitem ? $biblioitem->publishercode : q{},
338 collectiontitle => $biblioitem ? $biblioitem->collectiontitle : q{},
339 notes => $order->{'order_vendornote'},
340 quantity => $order->{'quantity'},
341 rrp => $order->{'rrp'},
343 for my $place ( qw( deliveryplace billingplace ) ) {
344 if ( my $library = Koha::Libraries->find( $row->{deliveryplace} ) ) {
345 $row->{$place} = $library->branchname
349 contractname author title publishercode collectiontitle notes
350 deliveryplace billingplace
352 # Double the quotes to not be interpreted as a field end
353 $row->{$_} =~ s/"/""/g if $row->{$_};
359 if(defined $a->{publishercode} and defined $b->{publishercode}) {
360 $a->{publishercode} cmp $b->{publishercode};
364 $template->param(rows => \@rows);
366 return $template->output;
371 =head3 GetBasketGroupAsCSV
373 &GetBasketGroupAsCSV($basketgroupid);
375 Export a basket group as CSV
377 $cgi parameter is needed for column name translation
381 sub GetBasketGroupAsCSV {
382 my ($basketgroupid, $cgi) = @_;
383 my $baskets = GetBasketsByBasketgroup($basketgroupid);
385 my $template = C4::Templates::gettemplate('acqui/csv/basketgroup.tt', 'intranet', $cgi);
388 for my $basket (@$baskets) {
389 my @orders = GetOrders( $basket->{basketno} );
390 my $contract = GetContract({
391 contractnumber => $basket->{contractnumber}
393 my $bookseller = Koha::Acquisition::Booksellers->find( $basket->{booksellerid} );
394 my $basketgroup = GetBasketgroup( $$basket{basketgroupid} );
396 foreach my $order (@orders) {
397 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
400 $biblioitem = $biblio->biblioitem;
403 clientnumber => $bookseller->accountnumber,
404 basketname => $basket->{basketname},
405 ordernumber => $order->{ordernumber},
406 author => $biblio ? $biblio->author : q{},
407 title => $biblio ? $biblio->title : q{},
408 publishercode => $biblioitem ? $biblioitem->publishercode : q{},
409 publicationyear => $biblioitem ? $biblioitem->publicationyear : q{},
410 collectiontitle => $biblioitem ? $biblioitem->collectiontitle : q{},
411 isbn => $order->{isbn},
412 quantity => $order->{quantity},
413 rrp_tax_included => $order->{rrp_tax_included},
414 rrp_tax_excluded => $order->{rrp_tax_excluded},
415 discount => $bookseller->discount,
416 ecost_tax_included => $order->{ecost_tax_included},
417 ecost_tax_excluded => $order->{ecost_tax_excluded},
418 notes => $order->{order_vendornote},
419 entrydate => $order->{entrydate},
420 booksellername => $bookseller->name,
421 bookselleraddress => $bookseller->address1,
422 booksellerpostal => $bookseller->postal,
423 contractnumber => $contract->{contractnumber},
424 contractname => $contract->{contractname},
427 basketgroupdeliveryplace => $basketgroup->{deliveryplace},
428 basketgroupbillingplace => $basketgroup->{billingplace},
429 basketdeliveryplace => $basket->{deliveryplace},
430 basketbillingplace => $basket->{billingplace},
432 for my $place (qw( basketgroupdeliveryplace basketgroupbillingplace basketdeliveryplace basketbillingplace )) {
433 if ( my $library = Koha::Libraries->find( $temp->{$place} ) ) {
434 $row->{$place} = $library->branchname;
438 basketname author title publishercode collectiontitle notes
439 booksellername bookselleraddress booksellerpostal contractname
440 basketgroupdeliveryplace basketgroupbillingplace
441 basketdeliveryplace basketbillingplace
443 # Double the quotes to not be interpreted as a field end
444 $row->{$_} =~ s/"/""/g if $row->{$_};
449 $template->param(rows => \@rows);
451 return $template->output;
455 =head3 CloseBasketgroup
457 &CloseBasketgroup($basketgroupno);
463 sub CloseBasketgroup {
464 my ($basketgroupno) = @_;
465 my $dbh = C4::Context->dbh;
466 my $sth = $dbh->prepare("
467 UPDATE aqbasketgroups
471 $sth->execute($basketgroupno);
474 #------------------------------------------------------------#
476 =head3 ReOpenBaskergroup($basketgroupno)
478 &ReOpenBaskergroup($basketgroupno);
484 sub ReOpenBasketgroup {
485 my ($basketgroupno) = @_;
486 my $dbh = C4::Context->dbh;
487 my $sth = $dbh->prepare("
488 UPDATE aqbasketgroups
492 $sth->execute($basketgroupno);
495 #------------------------------------------------------------#
499 &ModBasket($basketinfo);
501 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
505 =item C<$basketno> is the primary key of the basket in the aqbasket table.
512 my $basketinfo = shift;
513 my $query = "UPDATE aqbasket SET ";
515 foreach my $key (keys %$basketinfo){
516 if ($key ne 'basketno'){
517 $query .= "$key=?, ";
518 push(@params, $basketinfo->{$key} || undef );
521 # get rid of the "," at the end of $query
522 if (substr($query, length($query)-2) eq ', '){
527 $query .= "WHERE basketno=?";
528 push(@params, $basketinfo->{'basketno'});
529 my $dbh = C4::Context->dbh;
530 my $sth = $dbh->prepare($query);
531 $sth->execute(@params);
533 # Log the basket update
534 if (C4::Context->preference("AcquisitionLog")) {
535 my $modified = Koha::Acquisition::Baskets->find(
536 $basketinfo->{basketno}
541 $basketinfo->{basketno},
542 to_json($modified->unblessed)
549 #------------------------------------------------------------#
551 =head3 ModBasketHeader
553 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
555 Modifies a basket's header.
559 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
561 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
563 =item C<$note> is the "note" field in the "aqbasket" table;
565 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
567 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
569 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
571 =item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
573 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
575 =item C<$is_standing> is the "is_standing" field in the aqbasket table.
577 =item C<$create_items> should be set to 'ordering', 'receiving' or 'cataloguing' (or undef, in which
578 case the AcqCreateItem syspref takes precedence).
584 sub ModBasketHeader {
585 my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items) = @_;
590 SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=?, is_standing=?, create_items=?
594 my $dbh = C4::Context->dbh;
595 my $sth = $dbh->prepare($query);
596 $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items || undef, $basketno);
598 if ( $contractnumber ) {
599 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
600 my $sth2 = $dbh->prepare($query2);
601 $sth2->execute($contractnumber,$basketno);
604 # Log the basket update
605 if (C4::Context->preference("AcquisitionLog")) {
606 my $modified = Koha::Acquisition::Baskets->find(
611 'MODIFY_BASKET_HEADER',
613 to_json($modified->unblessed)
620 #------------------------------------------------------------#
622 =head3 GetBasketsByBookseller
624 @results = &GetBasketsByBookseller($booksellerid, $extra);
626 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
630 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
632 =item C<$extra> is the extra sql parameters, can be
634 $extra->{groupby}: group baskets by column
635 ex. $extra->{groupby} = aqbasket.basketgroupid
636 $extra->{orderby}: order baskets by column
637 $extra->{limit}: limit number of results (can be helpful for pagination)
643 sub GetBasketsByBookseller {
644 my ($booksellerid, $extra) = @_;
645 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
647 if ($extra->{groupby}) {
648 $query .= " GROUP by $extra->{groupby}";
650 if ($extra->{orderby}){
651 $query .= " ORDER by $extra->{orderby}";
653 if ($extra->{limit}){
654 $query .= " LIMIT $extra->{limit}";
657 my $dbh = C4::Context->dbh;
658 my $sth = $dbh->prepare($query);
659 $sth->execute($booksellerid);
660 return $sth->fetchall_arrayref({});
663 =head3 GetBasketsInfosByBookseller
665 my $baskets = GetBasketsInfosByBookseller($supplierid, $allbaskets);
667 The optional second parameter allbaskets is a boolean allowing you to
668 select all baskets from the supplier; by default only active baskets (open or
669 closed but still something to receive) are returned.
671 Returns in a arrayref of hashref all about booksellers baskets, plus:
672 total_biblios: Number of distinct biblios in basket
673 total_items: Number of items in basket
674 expected_items: Number of non-received items in basket
678 sub GetBasketsInfosByBookseller {
679 my ($supplierid, $allbaskets) = @_;
681 return unless $supplierid;
683 my $dbh = C4::Context->dbh;
685 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,
686 SUM(aqorders.quantity) AS total_items,
688 IF ( aqorders.orderstatus = 'cancelled', aqorders.quantity, 0 )
689 ) AS total_items_cancelled,
690 COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
692 IF(aqorders.datereceived IS NULL
693 AND aqorders.datecancellationprinted IS NULL
697 SUM( aqorders.uncertainprice ) AS uncertainprices
699 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
700 WHERE booksellerid = ?};
702 $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";
704 unless ( $allbaskets ) {
705 # Don't show the basket if it's NOT CLOSED or is FULLY RECEIVED
706 $query.=" HAVING (closedate IS NULL OR (
708 IF(aqorders.datereceived IS NULL
709 AND aqorders.datecancellationprinted IS NULL
715 my $sth = $dbh->prepare($query);
716 $sth->execute($supplierid);
717 my $baskets = $sth->fetchall_arrayref({});
719 # Retrieve the number of biblios cancelled
720 my $cancelled_biblios = $dbh->selectall_hashref( q|
721 SELECT COUNT(DISTINCT(biblionumber)) AS total_biblios_cancelled, aqbasket.basketno
723 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
724 WHERE booksellerid = ?
725 AND aqorders.orderstatus = 'cancelled'
726 GROUP BY aqbasket.basketno
727 |, 'basketno', {}, $supplierid );
729 $_->{total_biblios_cancelled} = $cancelled_biblios->{$_->{basketno}}{total_biblios_cancelled} || 0
735 =head3 GetBasketUsers
737 $basketusers_ids = &GetBasketUsers($basketno);
739 Returns a list of all borrowernumbers that are in basket users list
744 my $basketno = shift;
746 return unless $basketno;
749 SELECT borrowernumber
753 my $dbh = C4::Context->dbh;
754 my $sth = $dbh->prepare($query);
755 $sth->execute($basketno);
756 my $results = $sth->fetchall_arrayref( {} );
759 foreach (@$results) {
760 push @borrowernumbers, $_->{'borrowernumber'};
763 return @borrowernumbers;
766 =head3 ModBasketUsers
768 my @basketusers_ids = (1, 2, 3);
769 &ModBasketUsers($basketno, @basketusers_ids);
771 Delete all users from basket users list, and add users in C<@basketusers_ids>
777 my ($basketno, @basketusers_ids) = @_;
779 return unless $basketno;
781 my $dbh = C4::Context->dbh;
783 DELETE FROM aqbasketusers
786 my $sth = $dbh->prepare($query);
787 $sth->execute($basketno);
790 INSERT INTO aqbasketusers (basketno, borrowernumber)
793 $sth = $dbh->prepare($query);
794 foreach my $basketuser_id (@basketusers_ids) {
795 $sth->execute($basketno, $basketuser_id);
798 # Log the basket update
799 if (C4::Context->preference("AcquisitionLog")) {
802 'MODIFY_BASKET_USERS',
805 basketno => $basketno,
806 basketusers => @basketusers_ids
814 =head3 CanUserManageBasket
816 my $bool = CanUserManageBasket($borrower, $basket[, $userflags]);
817 my $bool = CanUserManageBasket($borrowernumber, $basketno[, $userflags]);
819 Check if a borrower can manage a basket, according to system preference
820 AcqViewBaskets, user permissions and basket properties (creator, users list,
823 First parameter can be either a borrowernumber or a hashref as returned by
824 Koha::Patron->unblessed
826 Second parameter can be either a basketno or a hashref as returned by
827 C4::Acquisition::GetBasket.
829 The third parameter is optional. If given, it should be a hashref as returned
830 by C4::Auth::getuserflags. If not, getuserflags is called.
832 If user is authorised to manage basket, returns 1.
837 sub CanUserManageBasket {
838 my ($borrower, $basket, $userflags) = @_;
840 if (!ref $borrower) {
841 # FIXME This needs to be replaced
842 # We should not accept both scalar and array
843 # Tests need to be updated
844 $borrower = Koha::Patrons->find( $borrower )->unblessed;
847 $basket = GetBasket($basket);
850 return 0 unless ($basket and $borrower);
852 my $borrowernumber = $borrower->{borrowernumber};
853 my $basketno = $basket->{basketno};
855 my $AcqViewBaskets = C4::Context->preference('AcqViewBaskets');
857 if (!defined $userflags) {
858 my $dbh = C4::Context->dbh;
859 my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE borrowernumber = ?");
860 $sth->execute($borrowernumber);
861 my ($flags) = $sth->fetchrow_array;
864 $userflags = C4::Auth::getuserflags($flags, $borrower->{userid}, $dbh);
867 unless ($userflags->{superlibrarian}
868 || (ref $userflags->{acquisition} && $userflags->{acquisition}->{order_manage_all})
869 || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
871 if (not exists $userflags->{acquisition}) {
875 if ( (ref $userflags->{acquisition} && !$userflags->{acquisition}->{order_manage})
876 || (!ref $userflags->{acquisition} && !$userflags->{acquisition}) ) {
880 if ($AcqViewBaskets eq 'user'
881 && $basket->{authorisedby} != $borrowernumber
882 && ! grep { $borrowernumber eq $_ } GetBasketUsers($basketno)) {
886 if ($AcqViewBaskets eq 'branch' && defined $basket->{branch}
887 && $basket->{branch} ne $borrower->{branchcode}) {
895 #------------------------------------------------------------#
897 =head3 GetBasketsByBasketgroup
899 $baskets = &GetBasketsByBasketgroup($basketgroupid);
901 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
905 sub GetBasketsByBasketgroup {
906 my $basketgroupid = shift;
908 SELECT *, aqbasket.booksellerid as booksellerid
910 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?
912 my $dbh = C4::Context->dbh;
913 my $sth = $dbh->prepare($query);
914 $sth->execute($basketgroupid);
915 return $sth->fetchall_arrayref({});
918 #------------------------------------------------------------#
920 =head3 NewBasketgroup
922 $basketgroupid = NewBasketgroup(\%hashref);
924 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
926 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
928 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
930 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
932 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
934 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
936 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
938 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
940 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
945 my $basketgroupinfo = shift;
946 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
947 my $query = "INSERT INTO aqbasketgroups (";
949 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
950 if ( defined $basketgroupinfo->{$field} ) {
951 $query .= "$field, ";
952 push(@params, $basketgroupinfo->{$field});
955 $query .= "booksellerid) VALUES (";
960 push(@params, $basketgroupinfo->{'booksellerid'});
961 my $dbh = C4::Context->dbh;
962 my $sth = $dbh->prepare($query);
963 $sth->execute(@params);
964 my $basketgroupid = $dbh->{'mysql_insertid'};
965 if( $basketgroupinfo->{'basketlist'} ) {
966 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
967 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
968 my $sth2 = $dbh->prepare($query2);
969 $sth2->execute($basketgroupid, $basketno);
972 return $basketgroupid;
975 #------------------------------------------------------------#
977 =head3 ModBasketgroup
979 ModBasketgroup(\%hashref);
981 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
983 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
985 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
987 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
989 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
991 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
993 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
995 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
997 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
1001 sub ModBasketgroup {
1002 my $basketgroupinfo = shift;
1003 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
1004 my $dbh = C4::Context->dbh;
1005 my $query = "UPDATE aqbasketgroups SET ";
1007 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
1008 if ( defined $basketgroupinfo->{$field} ) {
1009 $query .= "$field=?, ";
1010 push(@params, $basketgroupinfo->{$field});
1015 $query .= " WHERE id=?";
1016 push(@params, $basketgroupinfo->{'id'});
1017 my $sth = $dbh->prepare($query);
1018 $sth->execute(@params);
1020 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
1021 $sth->execute($basketgroupinfo->{'id'});
1023 if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
1024 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
1025 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
1026 $sth->execute($basketgroupinfo->{'id'}, $basketno);
1032 #------------------------------------------------------------#
1034 =head3 DelBasketgroup
1036 DelBasketgroup($basketgroupid);
1038 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
1042 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
1048 sub DelBasketgroup {
1049 my $basketgroupid = shift;
1050 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1051 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
1052 my $dbh = C4::Context->dbh;
1053 my $sth = $dbh->prepare($query);
1054 $sth->execute($basketgroupid);
1058 #------------------------------------------------------------#
1061 =head2 FUNCTIONS ABOUT ORDERS
1063 =head3 GetBasketgroup
1065 $basketgroup = &GetBasketgroup($basketgroupid);
1067 Returns a reference to the hash containing all information about the basketgroup.
1071 sub GetBasketgroup {
1072 my $basketgroupid = shift;
1073 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1074 my $dbh = C4::Context->dbh;
1075 my $result_set = $dbh->selectall_arrayref(
1076 'SELECT * FROM aqbasketgroups WHERE id=?',
1080 return $result_set->[0]; # id is unique
1083 #------------------------------------------------------------#
1085 =head3 GetBasketgroups
1087 $basketgroups = &GetBasketgroups($booksellerid);
1089 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
1093 sub GetBasketgroups {
1094 my $booksellerid = shift;
1095 die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
1096 my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
1097 my $dbh = C4::Context->dbh;
1098 my $sth = $dbh->prepare($query);
1099 $sth->execute($booksellerid);
1100 return $sth->fetchall_arrayref({});
1103 #------------------------------------------------------------#
1105 =head2 FUNCTIONS ABOUT ORDERS
1109 @orders = &GetOrders( $basketno, { orderby => 'biblio.title', cancelled => 0|1 } );
1111 Looks up the pending (non-cancelled) orders with the given basket
1114 If cancelled is set, only cancelled orders will be returned.
1119 my ( $basketno, $params ) = @_;
1121 return () unless $basketno;
1123 my $orderby = $params->{orderby};
1124 my $cancelled = $params->{cancelled} || 0;
1126 my $dbh = C4::Context->dbh;
1128 SELECT biblio.*,biblioitems.*,
1132 $query .= $cancelled
1134 aqorders_transfers.ordernumber_to AS transferred_to,
1135 aqorders_transfers.timestamp AS transferred_to_timestamp
1138 aqorders_transfers.ordernumber_from AS transferred_from,
1139 aqorders_transfers.timestamp AS transferred_from_timestamp
1143 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1144 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1145 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1147 $query .= $cancelled
1149 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
1152 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1160 $orderby ||= q|biblioitems.publishercode, biblio.title|;
1162 AND datecancellationprinted IS NOT NULL
1167 q|aqorders.datecancellationprinted desc, aqorders.timestamp desc|;
1169 AND datecancellationprinted IS NULL
1173 $query .= " ORDER BY $orderby";
1175 $dbh->selectall_arrayref( $query, { Slice => {} }, $basketno );
1180 #------------------------------------------------------------#
1182 =head3 GetOrdersByBiblionumber
1184 @orders = &GetOrdersByBiblionumber($biblionumber);
1186 Looks up the orders with linked to a specific $biblionumber, including
1187 cancelled orders and received orders.
1190 C<@orders> is an array of references-to-hash, whose keys are the
1191 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
1195 sub GetOrdersByBiblionumber {
1196 my $biblionumber = shift;
1197 return unless $biblionumber;
1198 my $dbh = C4::Context->dbh;
1200 SELECT biblio.*,biblioitems.*,
1204 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1205 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1206 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1207 WHERE aqorders.biblionumber=?
1210 $dbh->selectall_arrayref( $query, { Slice => {} }, $biblionumber );
1211 return @{$result_set};
1215 #------------------------------------------------------------#
1219 $order = &GetOrder($ordernumber);
1221 Looks up an order by order number.
1223 Returns a reference-to-hash describing the order. The keys of
1224 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1229 my ($ordernumber) = @_;
1230 return unless $ordernumber;
1232 my $dbh = C4::Context->dbh;
1233 my $query = qq{SELECT
1237 aqbasket.basketname,
1238 borrowers.branchcode,
1239 biblioitems.publicationyear,
1240 biblio.copyrightdate,
1241 biblioitems.editionstatement,
1245 biblioitems.publishercode,
1246 aqorders.rrp AS unitpricesupplier,
1247 aqorders.ecost AS unitpricelib,
1248 aqbudgets.budget_name AS budget,
1249 aqbooksellers.name AS supplier,
1250 aqbooksellers.id AS supplierid,
1251 biblioitems.publishercode AS publisher,
1252 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1253 DATE(aqbasket.closedate) AS orderdate,
1254 aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity_to_receive,
1255 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1256 DATEDIFF(CURDATE( ),closedate) AS latesince
1257 FROM aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1258 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1259 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1260 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
1261 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1262 WHERE aqorders.basketno = aqbasket.basketno
1265 $dbh->selectall_arrayref( $query, { Slice => {} }, $ordernumber );
1267 # result_set assumed to contain 1 match
1268 return $result_set->[0];
1273 &ModOrder(\%hashref);
1275 Modifies an existing order. Updates the order with order number
1276 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1277 other keys of the hash update the fields with the same name in the aqorders
1278 table of the Koha database.
1283 my $orderinfo = shift;
1285 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '';
1287 my $dbh = C4::Context->dbh;
1290 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1291 $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1293 # delete($orderinfo->{'branchcode'});
1294 # the hash contains a lot of entries not in aqorders, so get the columns ...
1295 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1297 my $colnames = $sth->{NAME};
1298 #FIXME Be careful. If aqorders would have columns with diacritics,
1299 #you should need to decode what you get back from NAME.
1300 #See report 10110 and guided_reports.pl
1301 my $query = "UPDATE aqorders SET ";
1303 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1304 # ... and skip hash entries that are not in the aqorders table
1305 # FIXME : probably not the best way to do it (would be better to have a correct hash)
1306 next unless grep { $_ eq $orderinfokey } @$colnames;
1307 $query .= "$orderinfokey=?, ";
1308 push(@params, $orderinfo->{$orderinfokey});
1311 $query .= "timestamp=NOW() WHERE ordernumber=?";
1312 push(@params, $orderinfo->{'ordernumber'} );
1313 $sth = $dbh->prepare($query);
1314 $sth->execute(@params);
1318 #------------------------------------------------------------#
1322 ModItemOrder($itemnumber, $ordernumber);
1324 Modifies the ordernumber of an item in aqorders_items.
1329 my ($itemnumber, $ordernumber) = @_;
1331 return unless ($itemnumber and $ordernumber);
1333 my $dbh = C4::Context->dbh;
1335 UPDATE aqorders_items
1337 WHERE itemnumber = ?
1339 my $sth = $dbh->prepare($query);
1340 return $sth->execute($ordernumber, $itemnumber);
1343 #------------------------------------------------------------#
1345 =head3 ModReceiveOrder
1347 my ( $date_received, $new_ordernumber ) = ModReceiveOrder(
1349 biblionumber => $biblionumber,
1351 quantityreceived => $quantityreceived,
1353 invoice => $invoice,
1354 budget_id => $budget_id,
1355 datereceived => $datereceived,
1356 received_itemnumbers => \@received_itemnumbers,
1360 Updates an order, to reflect the fact that it was received, at least
1363 If a partial order is received, splits the order into two.
1365 Updates the order with biblionumber C<$biblionumber> and ordernumber
1366 C<$order->{ordernumber}>.
1371 sub ModReceiveOrder {
1373 my $biblionumber = $params->{biblionumber};
1374 my $order = { %{ $params->{order} } }; # Copy the order, we don't want to modify it
1375 my $invoice = $params->{invoice};
1376 my $quantrec = $params->{quantityreceived};
1377 my $user = $params->{user};
1378 my $budget_id = $params->{budget_id};
1379 my $datereceived = $params->{datereceived};
1380 my $received_items = $params->{received_items};
1382 my $dbh = C4::Context->dbh;
1383 $datereceived = output_pref(
1385 dt => ( $datereceived ? dt_from_string( $datereceived ) : dt_from_string ),
1386 dateformat => 'iso',
1391 my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1392 if ($suggestionid) {
1393 ModSuggestion( {suggestionid=>$suggestionid,
1394 STATUS=>'AVAILABLE',
1395 biblionumber=> $biblionumber}
1399 my $result_set = $dbh->selectrow_arrayref(
1400 q{SELECT aqbasket.is_standing
1402 WHERE basketno=?},{ Slice => {} }, $order->{basketno});
1403 my $is_standing = $result_set->[0]; # we assume we have a unique basket
1405 my $new_ordernumber = $order->{ordernumber};
1406 if ( $is_standing || $order->{quantity} > $quantrec ) {
1407 # Split order line in two parts: the first is the original order line
1408 # without received items (the quantity is decreased),
1409 # the second part is a new order line with quantity=quantityrec
1410 # (entirely received)
1414 orderstatus = 'partial'|;
1415 $query .= q| WHERE ordernumber = ?|;
1416 my $sth = $dbh->prepare($query);
1419 ( $is_standing ? 1 : ($order->{quantity} - $quantrec) ),
1420 $order->{ordernumber}
1423 if ( not $order->{subscriptionid} && defined $order->{order_internalnote} ) {
1426 SET order_internalnote = ?
1427 WHERE ordernumber = ?|, {},
1428 $order->{order_internalnote}, $order->{ordernumber}
1432 # Recalculate tax_value
1436 tax_value_on_ordering = quantity * | . get_rounding_sql(q|ecost_tax_excluded|) . q| * tax_rate_on_ordering,
1437 tax_value_on_receiving = quantity * | . get_rounding_sql(q|unitprice_tax_excluded|) . q| * tax_rate_on_receiving
1438 WHERE ordernumber = ?
1439 |, undef, $order->{ordernumber});
1441 delete $order->{ordernumber};
1442 $order->{budget_id} = ( $budget_id || $order->{budget_id} );
1443 $order->{quantity} = $quantrec;
1444 $order->{quantityreceived} = $quantrec;
1445 $order->{ecost_tax_excluded} //= 0;
1446 $order->{tax_rate_on_ordering} //= 0;
1447 $order->{unitprice_tax_excluded} //= 0;
1448 $order->{tax_rate_on_receiving} //= 0;
1449 $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($order->{ecost_tax_excluded}) * $order->{tax_rate_on_ordering};
1450 $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
1451 $order->{datereceived} = $datereceived;
1452 $order->{invoiceid} = $invoice->{invoiceid};
1453 $order->{orderstatus} = 'complete';
1454 $new_ordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber; # TODO What if the store fails?
1456 if ($received_items) {
1457 foreach my $itemnumber (@$received_items) {
1458 ModItemOrder($itemnumber, $new_ordernumber);
1464 SET quantityreceived = ?,
1468 orderstatus = 'complete'
1472 , replacementprice = ?
1473 | if defined $order->{replacementprice};
1476 , unitprice = ?, unitprice_tax_included = ?, unitprice_tax_excluded = ?
1477 | if defined $order->{unitprice};
1480 ,tax_value_on_receiving = ?
1481 | if defined $order->{tax_value_on_receiving};
1484 ,tax_rate_on_receiving = ?
1485 | if defined $order->{tax_rate_on_receiving};
1488 , order_internalnote = ?
1489 | if defined $order->{order_internalnote};
1491 $query .= q| where biblionumber=? and ordernumber=?|;
1493 my $sth = $dbh->prepare( $query );
1494 my @params = ( $quantrec, $datereceived, $invoice->{invoiceid}, ( $budget_id ? $budget_id : $order->{budget_id} ) );
1496 if ( defined $order->{replacementprice} ) {
1497 push @params, $order->{replacementprice};
1500 if ( defined $order->{unitprice} ) {
1501 push @params, $order->{unitprice}, $order->{unitprice_tax_included}, $order->{unitprice_tax_excluded};
1504 if ( defined $order->{tax_value_on_receiving} ) {
1505 push @params, $order->{tax_value_on_receiving};
1508 if ( defined $order->{tax_rate_on_receiving} ) {
1509 push @params, $order->{tax_rate_on_receiving};
1512 if ( defined $order->{order_internalnote} ) {
1513 push @params, $order->{order_internalnote};
1516 push @params, ( $biblionumber, $order->{ordernumber} );
1518 $sth->execute( @params );
1520 # All items have been received, sent a notification to users
1521 NotifyOrderUsers( $order->{ordernumber} );
1524 return ($datereceived, $new_ordernumber);
1527 =head3 CancelReceipt
1529 my $parent_ordernumber = CancelReceipt($ordernumber);
1531 Cancel an order line receipt and update the parent order line, as if no
1533 If items are created at receipt (AcqCreateItem = receiving) then delete
1539 my $ordernumber = shift;
1541 return unless $ordernumber;
1543 my $dbh = C4::Context->dbh;
1545 SELECT datereceived, parent_ordernumber, quantity
1547 WHERE ordernumber = ?
1549 my $sth = $dbh->prepare($query);
1550 $sth->execute($ordernumber);
1551 my $order = $sth->fetchrow_hashref;
1553 warn "CancelReceipt: order $ordernumber does not exist";
1556 unless($order->{'datereceived'}) {
1557 warn "CancelReceipt: order $ordernumber is not received";
1561 my $parent_ordernumber = $order->{'parent_ordernumber'};
1563 my $order_obj = Koha::Acquisition::Orders->find( $ordernumber ); # FIXME rewrite all this subroutine using this object
1564 my @itemnumbers = $order_obj->items->get_column('itemnumber');
1566 if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1567 # The order line has no parent, just mark it as not received
1570 SET quantityreceived = ?,
1573 orderstatus = 'ordered'
1574 WHERE ordernumber = ?
1576 $sth = $dbh->prepare($query);
1577 $sth->execute(0, undef, undef, $ordernumber);
1578 _cancel_items_receipt( $order_obj );
1580 # The order line has a parent, increase parent quantity and delete
1582 unless ( $order_obj->basket->is_standing ) {
1584 SELECT quantity, datereceived
1586 WHERE ordernumber = ?
1588 $sth = $dbh->prepare($query);
1589 $sth->execute($parent_ordernumber);
1590 my $parent_order = $sth->fetchrow_hashref;
1591 unless($parent_order) {
1592 warn "Parent order $parent_ordernumber does not exist.";
1595 if($parent_order->{'datereceived'}) {
1596 warn "CancelReceipt: parent order is received.".
1597 " Can't cancel receipt.";
1603 orderstatus = 'ordered'
1604 WHERE ordernumber = ?
1606 $sth = $dbh->prepare($query);
1607 my $rv = $sth->execute(
1608 $order->{'quantity'} + $parent_order->{'quantity'},
1612 warn "Cannot update parent order line, so do not cancel".
1617 # Recalculate tax_value
1621 tax_value_on_ordering = quantity * | . get_rounding_sql(q|ecost_tax_excluded|) . q| * tax_rate_on_ordering,
1622 tax_value_on_receiving = quantity * | . get_rounding_sql(q|unitprice_tax_excluded|) . q| * tax_rate_on_receiving
1623 WHERE ordernumber = ?
1624 |, undef, $parent_ordernumber);
1627 _cancel_items_receipt( $order_obj, $parent_ordernumber );
1630 DELETE FROM aqorders
1631 WHERE ordernumber = ?
1633 $sth = $dbh->prepare($query);
1634 $sth->execute($ordernumber);
1638 if( $order_obj->basket->effective_create_items eq 'ordering' ) {
1639 my @affects = split q{\|}, C4::Context->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1641 for my $in ( @itemnumbers ) {
1642 my $item = Koha::Items->find( $in ); # FIXME We do not need that, we already have Koha::Items from $order_obj->items
1643 my $biblio = $item->biblio;
1644 my ( $itemfield ) = GetMarcFromKohaField( 'items.itemnumber' );
1645 my $item_marc = C4::Items::GetMarcItem( $biblio->biblionumber, $in );
1646 for my $affect ( @affects ) {
1647 my ( $sf, $v ) = split q{=}, $affect, 2;
1648 foreach ( $item_marc->field($itemfield) ) {
1649 $_->update( $sf => $v );
1652 C4::Items::ModItemFromMarc( $item_marc, $biblio->biblionumber, $in );
1657 return $parent_ordernumber;
1660 sub _cancel_items_receipt {
1661 my ( $order, $parent_ordernumber ) = @_;
1662 $parent_ordernumber ||= $order->ordernumber;
1664 my $items = $order->items;
1665 if ( $order->basket->effective_create_items eq 'receiving' ) {
1666 # Remove items that were created at receipt
1668 DELETE FROM items, aqorders_items
1669 USING items, aqorders_items
1670 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1672 my $dbh = C4::Context->dbh;
1673 my $sth = $dbh->prepare($query);
1674 while ( my $item = $items->next ) {
1675 $sth->execute($item->itemnumber, $item->itemnumber);
1679 while ( my $item = $items->next ) {
1680 ModItemOrder($item->itemnumber, $parent_ordernumber);
1685 #------------------------------------------------------------#
1689 @results = &SearchOrders({
1690 ordernumber => $ordernumber,
1693 booksellerid => $booksellerid,
1694 basketno => $basketno,
1695 basketname => $basketname,
1696 basketgroupname => $basketgroupname,
1700 biblionumber => $biblionumber,
1701 budget_id => $budget_id
1704 Searches for orders filtered by criteria.
1706 C<$ordernumber> Finds matching orders or transferred orders by ordernumber.
1707 C<$search> Finds orders matching %$search% in title, author, or isbn.
1708 C<$owner> Finds order for the logged in user.
1709 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1710 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1713 C<@results> is an array of references-to-hash with the keys are fields
1714 from aqorders, biblio, biblioitems and aqbasket tables.
1719 my ( $params ) = @_;
1720 my $ordernumber = $params->{ordernumber};
1721 my $search = $params->{search};
1722 my $ean = $params->{ean};
1723 my $booksellerid = $params->{booksellerid};
1724 my $basketno = $params->{basketno};
1725 my $basketname = $params->{basketname};
1726 my $basketgroupname = $params->{basketgroupname};
1727 my $owner = $params->{owner};
1728 my $pending = $params->{pending};
1729 my $ordered = $params->{ordered};
1730 my $biblionumber = $params->{biblionumber};
1731 my $budget_id = $params->{budget_id};
1733 my $dbh = C4::Context->dbh;
1736 SELECT aqbasket.basketno,
1738 borrowers.firstname,
1741 biblioitems.biblioitemnumber,
1742 biblioitems.publishercode,
1743 biblioitems.publicationyear,
1744 aqbasket.authorisedby,
1745 aqbasket.booksellerid,
1747 aqbasket.creationdate,
1748 aqbasket.basketname,
1749 aqbasketgroups.id as basketgroupid,
1750 aqbasketgroups.name as basketgroupname,
1753 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1754 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1755 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1756 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1757 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1760 # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
1762 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1766 WHERE (datecancellationprinted is NULL)
1769 if ( $pending or $ordered ) {
1772 ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) )
1774 ( quantity > quantityreceived OR quantityreceived is NULL )
1778 $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1786 my $userenv = C4::Context->userenv;
1787 if ( C4::Context->preference("IndependentBranches") ) {
1788 unless ( C4::Context->IsSuperLibrarian() ) {
1791 borrowers.branchcode = ?
1792 OR borrowers.branchcode = ''
1795 push @args, $userenv->{branch};
1799 if ( $ordernumber ) {
1800 $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1801 push @args, ( $ordernumber, $ordernumber );
1803 if ( $biblionumber ) {
1804 $query .= 'AND aqorders.biblionumber = ?';
1805 push @args, $biblionumber;
1808 $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1809 push @args, ("%$search%","%$search%","%$search%");
1812 $query .= ' AND biblioitems.ean = ?';
1815 if ( $booksellerid ) {
1816 $query .= 'AND aqbasket.booksellerid = ?';
1817 push @args, $booksellerid;
1820 $query .= 'AND aqbasket.basketno = ?';
1821 push @args, $basketno;
1824 $query .= 'AND aqbasket.basketname LIKE ?';
1825 push @args, "%$basketname%";
1827 if( $basketgroupname ) {
1828 $query .= ' AND aqbasketgroups.name LIKE ?';
1829 push @args, "%$basketgroupname%";
1833 $query .= ' AND aqbasket.authorisedby=? ';
1834 push @args, $userenv->{'number'};
1838 $query .= ' AND aqorders.budget_id = ?';
1839 push @args, $budget_id;
1842 $query .= ' ORDER BY aqbasket.basketno';
1844 my $sth = $dbh->prepare($query);
1845 $sth->execute(@args);
1846 return $sth->fetchall_arrayref({});
1849 #------------------------------------------------------------#
1851 =head3 TransferOrder
1853 my $newordernumber = TransferOrder($ordernumber, $basketno);
1855 Transfer an order line to a basket.
1856 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1857 to BOOKSELLER on DATE' and create new order with internal note
1858 'Transferred from BOOKSELLER on DATE'.
1859 Move all attached items to the new order.
1860 Received orders cannot be transferred.
1861 Return the ordernumber of created order.
1866 my ($ordernumber, $basketno) = @_;
1868 return unless ($ordernumber and $basketno);
1870 my $order = Koha::Acquisition::Orders->find( $ordernumber ) or return;
1871 return if $order->datereceived;
1873 $order = $order->unblessed;
1875 my $basket = GetBasket($basketno);
1876 return unless $basket;
1878 my $dbh = C4::Context->dbh;
1879 my ($query, $sth, $rv);
1883 SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1884 WHERE ordernumber = ?
1886 $sth = $dbh->prepare($query);
1887 $rv = $sth->execute('cancelled', $ordernumber);
1889 delete $order->{'ordernumber'};
1890 delete $order->{parent_ordernumber};
1891 $order->{'basketno'} = $basketno;
1893 my $newordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber;
1896 UPDATE aqorders_items
1898 WHERE ordernumber = ?
1900 $sth = $dbh->prepare($query);
1901 $sth->execute($newordernumber, $ordernumber);
1904 INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1907 $sth = $dbh->prepare($query);
1908 $sth->execute($ordernumber, $newordernumber);
1910 return $newordernumber;
1913 =head3 get_rounding_sql
1915 $rounding_sql = get_rounding_sql($column_name);
1917 returns the correct SQL routine based on OrderPriceRounding system preference.
1921 sub get_rounding_sql {
1922 my ( $round_string ) = @_;
1923 my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
1924 if ( $rounding_pref eq "nearest_cent" ) {
1925 return "CAST($round_string*100 AS SIGNED)/100";
1927 return $round_string;
1930 =head3 get_rounded_price
1932 $rounded_price = get_rounded_price( $price );
1934 returns a price rounded as specified in OrderPriceRounding system preference.
1938 sub get_rounded_price {
1940 my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
1941 if( $rounding_pref eq 'nearest_cent' ) {
1942 return Koha::Number::Price->new( $price )->round();
1948 =head2 FUNCTIONS ABOUT PARCELS
1952 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1954 get a lists of parcels.
1961 is the bookseller this function has to get parcels.
1964 To know on what criteria the results list has to be ordered.
1967 is the booksellerinvoicenumber.
1969 =item $datefrom & $dateto
1970 to know on what date this function has to filter its search.
1975 a pointer on a hash list containing parcel informations as such :
1981 =item Last operation
1983 =item Number of biblio
1985 =item Number of items
1992 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1993 my $dbh = C4::Context->dbh;
1994 my @query_params = ();
1996 SELECT aqinvoices.invoicenumber,
1997 datereceived,purchaseordernumber,
1998 count(DISTINCT biblionumber) AS biblio,
1999 sum(quantity) AS itemsexpected,
2000 sum(quantityreceived) AS itemsreceived
2001 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
2002 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2003 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
2005 push @query_params, $bookseller;
2007 if ( defined $code ) {
2008 $strsth .= ' and aqinvoices.invoicenumber like ? ';
2009 # add a % to the end of the code to allow stemming.
2010 push @query_params, "$code%";
2013 if ( defined $datefrom ) {
2014 $strsth .= ' and datereceived >= ? ';
2015 push @query_params, $datefrom;
2018 if ( defined $dateto ) {
2019 $strsth .= 'and datereceived <= ? ';
2020 push @query_params, $dateto;
2023 $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
2025 # can't use a placeholder to place this column name.
2026 # but, we could probably be checking to make sure it is a column that will be fetched.
2027 $strsth .= "order by $order " if ($order);
2029 my $sth = $dbh->prepare($strsth);
2031 $sth->execute( @query_params );
2032 my $results = $sth->fetchall_arrayref({});
2036 #------------------------------------------------------------#
2040 \@order_loop = GetHistory( %params );
2042 Retreives some acquisition history information
2052 basket - search both basket name and number
2053 booksellerinvoicenumber
2056 orderstatus (note that orderstatus '' will retrieve orders
2057 of any status except cancelled)
2061 get_canceled_order (if set to a true value, cancelled orders will
2065 $order_loop is a list of hashrefs that each look like this:
2067 'author' => 'Twain, Mark',
2069 'biblionumber' => '215',
2071 'creationdate' => 'MM/DD/YYYY',
2072 'datereceived' => undef,
2075 'invoicenumber' => undef,
2077 'ordernumber' => '1',
2079 'quantityreceived' => undef,
2080 'title' => 'The Adventures of Huckleberry Finn',
2081 'managing_library' => 'CPL'
2082 'is_standing' => '1'
2088 # don't run the query if there are no parameters (list would be too long for sure !)
2089 croak "No search params" unless @_;
2091 my $title = $params{title};
2092 my $author = $params{author};
2093 my $isbn = $params{isbn};
2094 my $ean = $params{ean};
2095 my $name = $params{name};
2096 my $internalnote = $params{internalnote};
2097 my $vendornote = $params{vendornote};
2098 my $from_placed_on = $params{from_placed_on};
2099 my $to_placed_on = $params{to_placed_on};
2100 my $basket = $params{basket};
2101 my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2102 my $basketgroupname = $params{basketgroupname};
2103 my $budget = $params{budget};
2104 my $orderstatus = $params{orderstatus};
2105 my $is_standing = $params{is_standing};
2106 my $biblionumber = $params{biblionumber};
2107 my $get_canceled_order = $params{get_canceled_order} || 0;
2108 my $ordernumber = $params{ordernumber};
2109 my $search_children_too = $params{search_children_too} || 0;
2110 my $created_by = $params{created_by} || [];
2111 my $managing_library = $params{managing_library};
2112 my $ordernumbers = $params{ordernumbers} || [];
2113 my $additional_fields = $params{additional_fields} // [];
2116 my $total_qtyreceived = 0;
2117 my $total_price = 0;
2119 #get variation of isbn
2123 if ( C4::Context->preference("SearchWithISBNVariations") ){
2124 @isbns = C4::Koha::GetVariationsOfISBN( $isbn );
2125 foreach my $isb (@isbns){
2126 push @isbn_params, '?';
2131 push @isbn_params, '?';
2135 my $dbh = C4::Context->dbh;
2138 COALESCE(biblio.title, deletedbiblio.title) AS title,
2139 COALESCE(biblio.author, deletedbiblio.author) AS author,
2140 COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2141 COALESCE(biblioitems.ean, deletedbiblioitems.ean) AS ean,
2143 aqbasket.basketname,
2144 aqbasket.basketgroupid,
2145 aqbasket.authorisedby,
2146 aqbasket.is_standing,
2147 concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2148 branch as managing_library,
2149 aqbasketgroups.name as groupname,
2151 aqbasket.creationdate,
2152 aqorders.datereceived,
2154 aqorders.quantityreceived,
2156 aqorders.ordernumber,
2158 aqinvoices.invoicenumber,
2159 aqbooksellers.id as id,
2160 aqorders.biblionumber,
2161 aqorders.orderstatus,
2162 aqorders.parent_ordernumber,
2163 aqorders.order_internalnote,
2164 aqorders.order_vendornote,
2165 aqbudgets.budget_name
2167 $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2170 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2171 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2172 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2173 LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2174 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2175 LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2176 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2177 LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2178 LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2179 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2182 $query .= " WHERE 1 ";
2184 unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2185 $query .= " AND datecancellationprinted IS NULL ";
2188 my @query_params = ();
2190 if ( $biblionumber ) {
2191 $query .= " AND biblio.biblionumber = ?";
2192 push @query_params, $biblionumber;
2196 $query .= " AND biblio.title LIKE ? ";
2197 $title =~ s/\s+/%/g;
2198 push @query_params, "%$title%";
2202 $query .= " AND biblio.author LIKE ? ";
2203 push @query_params, "%$author%";
2207 $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2208 foreach my $isb (@isbns){
2209 push @query_params, "%$isb%";
2214 $query .= " AND biblioitems.ean = ? ";
2215 push @query_params, "$ean";
2218 $query .= " AND aqbooksellers.name LIKE ? ";
2219 push @query_params, "%$name%";
2223 $query .= " AND aqbudgets.budget_id = ? ";
2224 push @query_params, "$budget";
2227 if ( $from_placed_on ) {
2228 $query .= " AND creationdate >= ? ";
2229 push @query_params, $from_placed_on;
2232 if ( $to_placed_on ) {
2233 $query .= " AND creationdate <= ? ";
2234 push @query_params, $to_placed_on;
2237 if ( defined $orderstatus and $orderstatus ne '') {
2238 $query .= " AND aqorders.orderstatus = ? ";
2239 push @query_params, "$orderstatus";
2242 if ( $is_standing ) {
2243 $query .= " AND is_standing = ? ";
2244 push @query_params, $is_standing;
2248 if ($basket =~ m/^\d+$/) {
2249 $query .= " AND aqorders.basketno = ? ";
2250 push @query_params, $basket;
2252 $query .= " AND aqbasket.basketname LIKE ? ";
2253 push @query_params, "%$basket%";
2257 if ( $internalnote ) {
2258 $query .= " AND aqorders.order_internalnote LIKE ? ";
2259 push @query_params, "%$internalnote%";
2262 if ( $vendornote ) {
2263 $query .= " AND aqorders.order_vendornote LIKE ?";
2264 push @query_params, "%$vendornote%";
2267 if ($booksellerinvoicenumber) {
2268 $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2269 push @query_params, "%$booksellerinvoicenumber%";
2272 if ($basketgroupname) {
2273 $query .= " AND aqbasketgroups.name LIKE ? ";
2274 push @query_params, "%$basketgroupname%";
2278 $query .= " AND (aqorders.ordernumber = ? ";
2279 push @query_params, $ordernumber;
2280 if ($search_children_too) {
2281 $query .= " OR aqorders.parent_ordernumber = ? ";
2282 push @query_params, $ordernumber;
2287 if ( @$created_by ) {
2288 $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2289 push @query_params, @$created_by;
2292 if ( $managing_library ) {
2293 $query .= " AND aqbasket.branch = ? ";
2294 push @query_params, $managing_library;
2297 if ( @$ordernumbers ) {
2298 $query .= ' AND (aqorders.ordernumber IN ( ' . join (',', ('?') x @$ordernumbers ) . '))';
2299 push @query_params, @$ordernumbers;
2301 if ( @$additional_fields ) {
2302 my @baskets = Koha::Acquisition::Baskets->filter_by_additional_fields($additional_fields)->as_list;
2304 return [] unless @baskets;
2306 # No parameterization because record IDs come directly from DB
2307 $query .= ' AND aqbasket.basketno IN ( ' . join( ',', map { $_->basketno } @baskets ) . ' )';
2310 if ( C4::Context->preference("IndependentBranches") ) {
2311 unless ( C4::Context->IsSuperLibrarian() ) {
2312 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2313 push @query_params, C4::Context->userenv->{branch};
2316 $query .= " ORDER BY id";
2318 return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2321 =head2 GetRecentAcqui
2323 $results = GetRecentAcqui($days);
2325 C<$results> is a ref to a table which contains hashref
2329 sub GetRecentAcqui {
2331 my $dbh = C4::Context->dbh;
2335 ORDER BY timestamp DESC
2338 my $sth = $dbh->prepare($query);
2340 my $results = $sth->fetchall_arrayref({});
2344 #------------------------------------------------------------#
2348 &AddClaim($ordernumber);
2350 Add a claim for an order
2355 my ($ordernumber) = @_;
2356 my $dbh = C4::Context->dbh;
2359 claims_count = claims_count + 1,
2360 claimed_date = CURDATE()
2361 WHERE ordernumber = ?
2363 my $sth = $dbh->prepare($query);
2364 $sth->execute($ordernumber);
2369 my @invoices = GetInvoices(
2370 invoicenumber => $invoicenumber,
2371 supplierid => $supplierid,
2372 suppliername => $suppliername,
2373 shipmentdatefrom => $shipmentdatefrom, # ISO format
2374 shipmentdateto => $shipmentdateto, # ISO format
2375 billingdatefrom => $billingdatefrom, # ISO format
2376 billingdateto => $billingdateto, # ISO format
2377 isbneanissn => $isbn_or_ean_or_issn,
2380 publisher => $publisher,
2381 publicationyear => $publicationyear,
2382 branchcode => $branchcode,
2383 order_by => $order_by
2386 Return a list of invoices that match all given criteria.
2388 $order_by is "column_name (asc|desc)", where column_name is any of
2389 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2390 'shipmentcost', 'shipmentcost_budgetid'.
2392 asc is the default if omitted
2399 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2400 closedate shipmentcost shipmentcost_budgetid);
2402 my $dbh = C4::Context->dbh;
2404 SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
2405 aqbooksellers.name AS suppliername,
2408 aqorders.datereceived IS NOT NULL,
2409 aqorders.biblionumber,
2412 ) AS receivedbiblios,
2415 aqorders.subscriptionid IS NOT NULL,
2416 aqorders.subscriptionid,
2419 ) AS is_linked_to_subscriptions,
2420 SUM(aqorders.quantityreceived) AS receiveditems
2422 LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2423 LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2424 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2425 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2426 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2427 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2428 LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2433 if($args{supplierid}) {
2434 push @bind_strs, " aqinvoices.booksellerid = ? ";
2435 push @bind_args, $args{supplierid};
2437 if($args{invoicenumber}) {
2438 push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2439 push @bind_args, "%$args{invoicenumber}%";
2441 if($args{suppliername}) {
2442 push @bind_strs, " aqbooksellers.name LIKE ? ";
2443 push @bind_args, "%$args{suppliername}%";
2445 if($args{shipmentdatefrom}) {
2446 push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2447 push @bind_args, $args{shipmentdatefrom};
2449 if($args{shipmentdateto}) {
2450 push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2451 push @bind_args, $args{shipmentdateto};
2453 if($args{billingdatefrom}) {
2454 push @bind_strs, " aqinvoices.billingdate >= ? ";
2455 push @bind_args, $args{billingdatefrom};
2457 if($args{billingdateto}) {
2458 push @bind_strs, " aqinvoices.billingdate <= ? ";
2459 push @bind_args, $args{billingdateto};
2461 if($args{isbneanissn}) {
2462 push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2463 push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2466 push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2467 push @bind_args, $args{title};
2470 push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2471 push @bind_args, $args{author};
2473 if($args{publisher}) {
2474 push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2475 push @bind_args, $args{publisher};
2477 if($args{publicationyear}) {
2478 push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2479 push @bind_args, $args{publicationyear}, $args{publicationyear};
2481 if($args{branchcode}) {
2482 push @bind_strs, " borrowers.branchcode = ? ";
2483 push @bind_args, $args{branchcode};
2485 if($args{message_id}) {
2486 push @bind_strs, " aqinvoices.message_id = ? ";
2487 push @bind_args, $args{message_id};
2490 $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2491 $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";
2493 if($args{order_by}) {
2494 my ($column, $direction) = split / /, $args{order_by};
2495 if(grep { $_ eq $column } @columns) {
2496 $direction ||= 'ASC';
2497 $query .= " ORDER BY $column $direction";
2501 my $sth = $dbh->prepare($query);
2502 $sth->execute(@bind_args);
2504 my $results = $sth->fetchall_arrayref({});
2510 my $invoice = GetInvoice($invoiceid);
2512 Get informations about invoice with given $invoiceid
2514 Return a hash filled with aqinvoices.* fields
2519 my ($invoiceid) = @_;
2522 return unless $invoiceid;
2524 my $dbh = C4::Context->dbh;
2530 my $sth = $dbh->prepare($query);
2531 $sth->execute($invoiceid);
2533 $invoice = $sth->fetchrow_hashref;
2537 =head3 GetInvoiceDetails
2539 my $invoice = GetInvoiceDetails($invoiceid)
2541 Return informations about an invoice + the list of related order lines
2543 Orders informations are in $invoice->{orders} (array ref)
2547 sub GetInvoiceDetails {
2548 my ($invoiceid) = @_;
2550 if ( !defined $invoiceid ) {
2551 carp 'GetInvoiceDetails called without an invoiceid';
2555 my $dbh = C4::Context->dbh;
2557 SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2559 LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2562 my $sth = $dbh->prepare($query);
2563 $sth->execute($invoiceid);
2565 my $invoice = $sth->fetchrow_hashref;
2570 biblio.copyrightdate,
2572 biblioitems.publishercode,
2573 biblioitems.publicationyear,
2574 aqbasket.basketname,
2575 aqbasketgroups.id AS basketgroupid,
2576 aqbasketgroups.name AS basketgroupname
2578 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2579 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2580 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2581 LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2584 $sth = $dbh->prepare($query);
2585 $sth->execute($invoiceid);
2586 $invoice->{orders} = $sth->fetchall_arrayref({});
2587 $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2594 my $invoiceid = AddInvoice(
2595 invoicenumber => $invoicenumber,
2596 booksellerid => $booksellerid,
2597 shipmentdate => $shipmentdate,
2598 billingdate => $billingdate,
2599 closedate => $closedate,
2600 shipmentcost => $shipmentcost,
2601 shipmentcost_budgetid => $shipmentcost_budgetid
2604 Create a new invoice and return its id or undef if it fails.
2611 return unless(%invoice and $invoice{invoicenumber});
2613 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2614 closedate shipmentcost shipmentcost_budgetid message_id);
2618 foreach my $key (keys %invoice) {
2619 if(0 < grep { $_ eq $key } @columns) {
2620 push @set_strs, "$key = ?";
2621 push @set_args, ($invoice{$key} || undef);
2627 my $dbh = C4::Context->dbh;
2628 my $query = "INSERT INTO aqinvoices SET ";
2629 $query .= join (",", @set_strs);
2630 my $sth = $dbh->prepare($query);
2631 $rv = $sth->execute(@set_args);
2633 $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2642 invoiceid => $invoiceid, # Mandatory
2643 invoicenumber => $invoicenumber,
2644 booksellerid => $booksellerid,
2645 shipmentdate => $shipmentdate,
2646 billingdate => $billingdate,
2647 closedate => $closedate,
2648 shipmentcost => $shipmentcost,
2649 shipmentcost_budgetid => $shipmentcost_budgetid
2652 Modify an invoice, invoiceid is mandatory.
2654 Return undef if it fails.
2661 return unless(%invoice and $invoice{invoiceid});
2663 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2664 closedate shipmentcost shipmentcost_budgetid);
2668 foreach my $key (keys %invoice) {
2669 if(0 < grep { $_ eq $key } @columns) {
2670 push @set_strs, "$key = ?";
2671 push @set_args, ($invoice{$key} || undef);
2675 my $dbh = C4::Context->dbh;
2676 my $query = "UPDATE aqinvoices SET ";
2677 $query .= join(",", @set_strs);
2678 $query .= " WHERE invoiceid = ?";
2680 my $sth = $dbh->prepare($query);
2681 $sth->execute(@set_args, $invoice{invoiceid});
2686 CloseInvoice($invoiceid);
2690 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2695 my ($invoiceid) = @_;
2697 return unless $invoiceid;
2699 my $dbh = C4::Context->dbh;
2702 SET closedate = CAST(NOW() AS DATE)
2705 my $sth = $dbh->prepare($query);
2706 $sth->execute($invoiceid);
2709 =head3 ReopenInvoice
2711 ReopenInvoice($invoiceid);
2715 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2720 my ($invoiceid) = @_;
2722 return unless $invoiceid;
2724 my $dbh = C4::Context->dbh;
2727 SET closedate = NULL
2730 my $sth = $dbh->prepare($query);
2731 $sth->execute($invoiceid);
2736 DelInvoice($invoiceid);
2738 Delete an invoice if there are no items attached to it.
2743 my ($invoiceid) = @_;
2745 return unless $invoiceid;
2747 my $dbh = C4::Context->dbh;
2753 my $sth = $dbh->prepare($query);
2754 $sth->execute($invoiceid);
2755 my $res = $sth->fetchrow_arrayref;
2756 if ( $res && $res->[0] == 0 ) {
2758 DELETE FROM aqinvoices
2761 my $sth = $dbh->prepare($query);
2762 return ( $sth->execute($invoiceid) > 0 );
2767 =head3 MergeInvoices
2769 MergeInvoices($invoiceid, \@sourceids);
2771 Merge the invoices identified by the IDs in \@sourceids into
2772 the invoice identified by $invoiceid.
2777 my ($invoiceid, $sourceids) = @_;
2779 return unless $invoiceid;
2780 foreach my $sourceid (@$sourceids) {
2781 next if $sourceid == $invoiceid;
2782 my $source = GetInvoiceDetails($sourceid);
2783 foreach my $order (@{$source->{'orders'}}) {
2784 $order->{'invoiceid'} = $invoiceid;
2787 DelInvoice($source->{'invoiceid'});
2792 =head3 GetBiblioCountByBasketno
2794 $biblio_count = &GetBiblioCountByBasketno($basketno);
2796 Looks up the biblio's count that has basketno value $basketno
2802 sub GetBiblioCountByBasketno {
2803 my ($basketno) = @_;
2804 my $dbh = C4::Context->dbh;
2806 SELECT COUNT( DISTINCT( biblionumber ) )
2809 AND datecancellationprinted IS NULL
2812 my $sth = $dbh->prepare($query);
2813 $sth->execute($basketno);
2814 return $sth->fetchrow;
2817 =head3 populate_order_with_prices
2819 $order = populate_order_with_prices({
2820 order => $order #a hashref with the order values
2821 booksellerid => $booksellerid #FIXME - should obtain from order basket
2822 receiving => 1 # boolean representing order stage, should pass only this or ordering
2823 ordering => 1 # boolean representing order stage
2827 Sets calculated values for an order - all values are stored with full precision
2828 regardless of rounding preference except for tax value which is calculated
2829 on rounded values if requested
2831 For ordering the values set are:
2836 tax_value_on_ordering
2837 For receiving the value set are:
2838 unitprice_tax_included
2839 unitprice_tax_excluded
2840 tax_value_on_receiving
2842 Note: When receiving, if the rounded value of the unitprice matches the rounded
2843 value of the ecost then then ecost (full precision) is used.
2845 Returns a hashref of the order
2847 FIXME: Move this to Koha::Acquisition::Order.pm
2851 sub populate_order_with_prices {
2854 my $order = $params->{order};
2855 my $booksellerid = $params->{booksellerid};
2856 return unless $booksellerid;
2858 my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
2860 my $receiving = $params->{receiving};
2861 my $ordering = $params->{ordering};
2862 my $discount = $order->{discount};
2863 $discount /= 100 if $discount > 1;
2866 $order->{tax_rate_on_ordering} //= $order->{tax_rate};
2867 if ( $bookseller->listincgst ) {
2869 # The user entered the prices tax included
2870 $order->{unitprice} += 0;
2871 $order->{unitprice_tax_included} = $order->{unitprice};
2872 $order->{rrp_tax_included} = $order->{rrp};
2874 # price tax excluded = price tax included / ( 1 + tax rate )
2875 $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2876 $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2878 # ecost tax included = rrp tax included ( 1 - discount )
2879 $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
2881 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2882 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2884 # tax value = quantity * ecost tax excluded * tax rate
2885 # we should use the unitprice if included
2886 my $cost_tax_included = $order->{unitprice_tax_included} == 0 ? $order->{ecost_tax_included} : $order->{unitprice_tax_included};
2887 my $cost_tax_excluded = $order->{unitprice_tax_excluded} == 0 ? $order->{ecost_tax_excluded} : $order->{unitprice_tax_excluded};
2888 $order->{tax_value_on_ordering} = ( get_rounded_price($cost_tax_included) - get_rounded_price($cost_tax_excluded) ) * $order->{quantity};
2892 # The user entered the prices tax excluded
2893 $order->{unitprice_tax_excluded} = $order->{unitprice};
2894 $order->{rrp_tax_excluded} = $order->{rrp};
2896 # price tax included = price tax excluded * ( 1 - tax rate )
2897 $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2898 $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2900 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2901 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2903 # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount ) = ecost tax excluded * ( 1 + tax rate )
2904 $order->{ecost_tax_included} = $order->{ecost_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2906 # tax value = quantity * ecost tax included * tax rate
2907 # we should use the unitprice if included
2908 my $cost_tax_excluded = $order->{unitprice_tax_excluded} == 0 ? $order->{ecost_tax_excluded} : $order->{unitprice_tax_excluded};
2909 $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($cost_tax_excluded) * $order->{tax_rate_on_ordering};
2914 $order->{tax_rate_on_receiving} //= $order->{tax_rate};
2915 if ( $bookseller->invoiceincgst ) {
2916 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2917 # we need to keep the exact ecost value
2918 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
2919 $order->{unitprice} = $order->{ecost_tax_included};
2922 # The user entered the unit price tax included
2923 $order->{unitprice_tax_included} = $order->{unitprice};
2925 # unit price tax excluded = unit price tax included / ( 1 + tax rate )
2926 $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
2929 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2930 # we need to keep the exact ecost value
2931 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
2932 $order->{unitprice} = $order->{ecost_tax_excluded};
2935 # The user entered the unit price tax excluded
2936 $order->{unitprice_tax_excluded} = $order->{unitprice};
2939 # unit price tax included = unit price tax included * ( 1 + tax rate )
2940 $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
2943 # tax value = quantity * unit price tax excluded * tax rate
2944 $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
2950 =head3 GetOrderUsers
2952 $order_users_ids = &GetOrderUsers($ordernumber);
2954 Returns a list of all borrowernumbers that are in order users list
2959 my ($ordernumber) = @_;
2961 return unless $ordernumber;
2964 SELECT borrowernumber
2966 WHERE ordernumber = ?
2968 my $dbh = C4::Context->dbh;
2969 my $sth = $dbh->prepare($query);
2970 $sth->execute($ordernumber);
2971 my $results = $sth->fetchall_arrayref( {} );
2973 my @borrowernumbers;
2974 foreach (@$results) {
2975 push @borrowernumbers, $_->{'borrowernumber'};
2978 return @borrowernumbers;
2981 =head3 ModOrderUsers
2983 my @order_users_ids = (1, 2, 3);
2984 &ModOrderUsers($ordernumber, @basketusers_ids);
2986 Delete all users from order users list, and add users in C<@order_users_ids>
2992 my ( $ordernumber, @order_users_ids ) = @_;
2994 return unless $ordernumber;
2996 my $dbh = C4::Context->dbh;
2998 DELETE FROM aqorder_users
2999 WHERE ordernumber = ?
3001 my $sth = $dbh->prepare($query);
3002 $sth->execute($ordernumber);
3005 INSERT INTO aqorder_users (ordernumber, borrowernumber)
3008 $sth = $dbh->prepare($query);
3009 foreach my $order_user_id (@order_users_ids) {
3010 $sth->execute( $ordernumber, $order_user_id );
3014 sub NotifyOrderUsers {
3015 my ($ordernumber) = @_;
3017 my @borrowernumbers = GetOrderUsers($ordernumber);
3018 return unless @borrowernumbers;
3020 my $order = GetOrder( $ordernumber );
3021 for my $borrowernumber (@borrowernumbers) {
3022 my $patron = Koha::Patrons->find( $borrowernumber );
3023 my $library = $patron->library->unblessed;
3024 my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed;
3025 my $letter = C4::Letters::GetPreparedLetter(
3026 module => 'acquisition',
3027 letter_code => 'ACQ_NOTIF_ON_RECEIV',
3028 branchcode => $library->{branchcode},
3029 lang => $patron->lang,
3031 'branches' => $library,
3032 'borrowers' => $patron->unblessed,
3033 'biblio' => $biblio,
3034 'aqorders' => $order,
3038 C4::Letters::EnqueueLetter(
3041 borrowernumber => $borrowernumber,
3042 LibraryName => C4::Context->preference("LibraryName"),
3043 message_transport_type => 'email',
3045 ) or warn "can't enqueue letter $letter";
3050 =head3 FillWithDefaultValues
3052 FillWithDefaultValues( $marc_record, $params );
3054 This will update the record with default value defined in the ACQ framework.
3055 For all existing fields, if a default value exists and there are no subfield, it will be created.
3056 If the field does not exist, it will be created too.
3058 If the parameter only_mandatory => 1 is passed via $params, only the mandatory
3059 defaults are being applied to the record.
3063 sub FillWithDefaultValues {
3064 my ( $record, $params ) = @_;
3065 my $mandatory = $params->{only_mandatory};
3066 my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3069 C4::Biblio::GetMarcFromKohaField( 'items.itemnumber' );
3070 for my $tag ( sort keys %$tagslib ) {
3072 next if $tag == $itemfield;
3073 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3074 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3075 next if $mandatory && !$tagslib->{$tag}{$subfield}{mandatory};
3076 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3077 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3078 my @fields = $record->field($tag);
3080 for my $field (@fields) {
3081 if ( $field->is_control_field ) {
3082 $field->update($defaultvalue) if not defined $field->data;
3084 elsif ( not defined $field->subfield($subfield) ) {
3085 $field->add_subfields(
3086 $subfield => $defaultvalue );
3091 if ( $tag < 10 ) { # is_control_field
3092 $record->insert_fields_ordered(
3099 $record->insert_fields_ordered(
3101 $tag, '', '', $subfield => $defaultvalue
3117 Koha Development Team <http://koha-community.org/>