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{};
202 ModBasketHeader( $basket, $basketname, $basketnote, $basketbooksellernote,
203 $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items );
205 # Log the basket creation
206 if (C4::Context->preference("AcquisitionLog")) {
207 my $created = Koha::Acquisition::Baskets->find( $basket );
212 to_json($created->unblessed)
221 &ReopenBasket($basketno);
229 my $dbh = C4::Context->dbh;
230 $dbh->do( q{UPDATE aqbasket SET closedate=NULL WHERE basketno=?}, {}, $basketno );
234 SET orderstatus = 'new'
236 AND orderstatus NOT IN ( 'complete', 'cancelled' )
239 # Log the basket reopening
240 if (C4::Context->preference("AcquisitionLog")) {
241 my $reopened = Koha::Acquisition::Baskets->find( $basketno );
246 to_json($reopened->unblessed)
252 #------------------------------------------------------------#
254 =head3 GetBasketAsCSV
256 &GetBasketAsCSV($basketno);
258 Export a basket as CSV
260 $cgi parameter is needed for column name translation
265 my ($basketno, $cgi, $csv_profile_id) = @_;
266 my $basket = GetBasket($basketno);
267 my @orders = GetOrders($basketno);
268 my $contract = GetContract({
269 contractnumber => $basket->{'contractnumber'}
272 my $template = C4::Templates::gettemplate("acqui/csv/basket.tt", "intranet", $cgi);
274 if ($csv_profile_id) {
275 my $csv_profile = Koha::CsvProfiles->find( $csv_profile_id );
276 Koha::Exceptions::ObjectNotFound->throw( 'There is no valid csv profile given') unless $csv_profile;
278 my $csv = Text::CSV_XS->new({'quote_char'=>'"','escape_char'=>'"','sep_char'=>$csv_profile->csv_separator,'binary'=>1});
279 my $csv_profile_content = $csv_profile->content;
280 my ( @headers, @fields );
281 while ( $csv_profile_content =~ /
284 ([^\|]*) # fieldname (table.row or row)
288 my $field = ($2 eq '') ? $1 : $2;
290 $header =~ s/^\s+|\s+$//g; # Trim whitespaces
291 push @headers, $header;
293 $field =~ s/[^\.]*\.{1}//; # Remove the table name if exists.
294 $field =~ s/^\s+|\s+$//g; # Trim whitespaces
295 push @fields, $field;
297 for my $order (@orders) {
299 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
300 my $biblioitem = $biblio->biblioitem;
301 $order = { %$order, %{ $biblioitem->unblessed } };
303 $order = {%$order, %$contract};
305 $order = {%$order, %$basket, %{ $biblio->unblessed }};
306 for my $field (@fields) {
307 push @row, $order->{$field};
311 my $content = join( $csv_profile->csv_separator, @headers ) . "\n";
312 for my $row ( @rows ) {
313 $csv->combine(@$row);
314 my $string = $csv->string;
315 $content .= $string . "\n";
320 foreach my $order (@orders) {
321 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
322 my $biblioitem = $biblio->biblioitem;
324 contractname => $contract->{'contractname'},
325 ordernumber => $order->{'ordernumber'},
326 entrydate => $order->{'entrydate'},
327 isbn => $order->{'isbn'},
328 author => $biblio->author,
329 title => $biblio->title,
330 publicationyear => $biblioitem->publicationyear,
331 publishercode => $biblioitem->publishercode,
332 collectiontitle => $biblioitem->collectiontitle,
333 notes => $order->{'order_vendornote'},
334 quantity => $order->{'quantity'},
335 rrp => $order->{'rrp'},
337 for my $place ( qw( deliveryplace billingplace ) ) {
338 if ( my $library = Koha::Libraries->find( $row->{deliveryplace} ) ) {
339 $row->{$place} = $library->branchname
343 contractname author title publishercode collectiontitle notes
344 deliveryplace billingplace
346 # Double the quotes to not be interpreted as a field end
347 $row->{$_} =~ s/"/""/g if $row->{$_};
353 if(defined $a->{publishercode} and defined $b->{publishercode}) {
354 $a->{publishercode} cmp $b->{publishercode};
358 $template->param(rows => \@rows);
360 return $template->output;
365 =head3 GetBasketGroupAsCSV
367 &GetBasketGroupAsCSV($basketgroupid);
369 Export a basket group as CSV
371 $cgi parameter is needed for column name translation
375 sub GetBasketGroupAsCSV {
376 my ($basketgroupid, $cgi) = @_;
377 my $baskets = GetBasketsByBasketgroup($basketgroupid);
379 my $template = C4::Templates::gettemplate('acqui/csv/basketgroup.tt', 'intranet', $cgi);
382 for my $basket (@$baskets) {
383 my @orders = GetOrders( $basket->{basketno} );
384 my $contract = GetContract({
385 contractnumber => $basket->{contractnumber}
387 my $bookseller = Koha::Acquisition::Booksellers->find( $basket->{booksellerid} );
388 my $basketgroup = GetBasketgroup( $$basket{basketgroupid} );
390 foreach my $order (@orders) {
391 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
392 my $biblioitem = $biblio->biblioitem;
394 clientnumber => $bookseller->accountnumber,
395 basketname => $basket->{basketname},
396 ordernumber => $order->{ordernumber},
397 author => $biblio->author,
398 title => $biblio->title,
399 publishercode => $biblioitem->publishercode,
400 publicationyear => $biblioitem->publicationyear,
401 collectiontitle => $biblioitem->collectiontitle,
402 isbn => $order->{isbn},
403 quantity => $order->{quantity},
404 rrp_tax_included => $order->{rrp_tax_included},
405 rrp_tax_excluded => $order->{rrp_tax_excluded},
406 discount => $bookseller->discount,
407 ecost_tax_included => $order->{ecost_tax_included},
408 ecost_tax_excluded => $order->{ecost_tax_excluded},
409 notes => $order->{order_vendornote},
410 entrydate => $order->{entrydate},
411 booksellername => $bookseller->name,
412 bookselleraddress => $bookseller->address1,
413 booksellerpostal => $bookseller->postal,
414 contractnumber => $contract->{contractnumber},
415 contractname => $contract->{contractname},
418 basketgroupdeliveryplace => $basketgroup->{deliveryplace},
419 basketgroupbillingplace => $basketgroup->{billingplace},
420 basketdeliveryplace => $basket->{deliveryplace},
421 basketbillingplace => $basket->{billingplace},
423 for my $place (qw( basketgroupdeliveryplace basketgroupbillingplace basketdeliveryplace basketbillingplace )) {
424 if ( my $library = Koha::Libraries->find( $temp->{$place} ) ) {
425 $row->{$place} = $library->branchname;
429 basketname author title publishercode collectiontitle notes
430 booksellername bookselleraddress booksellerpostal contractname
431 basketgroupdeliveryplace basketgroupbillingplace
432 basketdeliveryplace basketbillingplace
434 # Double the quotes to not be interpreted as a field end
435 $row->{$_} =~ s/"/""/g if $row->{$_};
440 $template->param(rows => \@rows);
442 return $template->output;
446 =head3 CloseBasketgroup
448 &CloseBasketgroup($basketgroupno);
454 sub CloseBasketgroup {
455 my ($basketgroupno) = @_;
456 my $dbh = C4::Context->dbh;
457 my $sth = $dbh->prepare("
458 UPDATE aqbasketgroups
462 $sth->execute($basketgroupno);
465 #------------------------------------------------------------#
467 =head3 ReOpenBaskergroup($basketgroupno)
469 &ReOpenBaskergroup($basketgroupno);
475 sub ReOpenBasketgroup {
476 my ($basketgroupno) = @_;
477 my $dbh = C4::Context->dbh;
478 my $sth = $dbh->prepare("
479 UPDATE aqbasketgroups
483 $sth->execute($basketgroupno);
486 #------------------------------------------------------------#
490 &ModBasket($basketinfo);
492 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
496 =item C<$basketno> is the primary key of the basket in the aqbasket table.
503 my $basketinfo = shift;
504 my $query = "UPDATE aqbasket SET ";
506 foreach my $key (keys %$basketinfo){
507 if ($key ne 'basketno'){
508 $query .= "$key=?, ";
509 push(@params, $basketinfo->{$key} || undef );
512 # get rid of the "," at the end of $query
513 if (substr($query, length($query)-2) eq ', '){
518 $query .= "WHERE basketno=?";
519 push(@params, $basketinfo->{'basketno'});
520 my $dbh = C4::Context->dbh;
521 my $sth = $dbh->prepare($query);
522 $sth->execute(@params);
524 # Log the basket update
525 if (C4::Context->preference("AcquisitionLog")) {
526 my $modified = Koha::Acquisition::Baskets->find(
527 $basketinfo->{basketno}
532 $basketinfo->{basketno},
533 to_json($modified->unblessed)
540 #------------------------------------------------------------#
542 =head3 ModBasketHeader
544 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
546 Modifies a basket's header.
550 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
552 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
554 =item C<$note> is the "note" field in the "aqbasket" table;
556 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
558 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
560 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
562 =item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
564 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
566 =item C<$is_standing> is the "is_standing" field in the aqbasket table.
568 =item C<$create_items> should be set to 'ordering', 'receiving' or 'cataloguing' (or undef, in which
569 case the AcqCreateItem syspref takes precedence).
575 sub ModBasketHeader {
576 my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items) = @_;
581 SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=?, is_standing=?, create_items=?
585 my $dbh = C4::Context->dbh;
586 my $sth = $dbh->prepare($query);
587 $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items || undef, $basketno);
589 if ( $contractnumber ) {
590 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
591 my $sth2 = $dbh->prepare($query2);
592 $sth2->execute($contractnumber,$basketno);
595 # Log the basket update
596 if (C4::Context->preference("AcquisitionLog")) {
597 my $modified = Koha::Acquisition::Baskets->find(
602 'MODIFY_BASKET_HEADER',
604 to_json($modified->unblessed)
611 #------------------------------------------------------------#
613 =head3 GetBasketsByBookseller
615 @results = &GetBasketsByBookseller($booksellerid, $extra);
617 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
621 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
623 =item C<$extra> is the extra sql parameters, can be
625 $extra->{groupby}: group baskets by column
626 ex. $extra->{groupby} = aqbasket.basketgroupid
627 $extra->{orderby}: order baskets by column
628 $extra->{limit}: limit number of results (can be helpful for pagination)
634 sub GetBasketsByBookseller {
635 my ($booksellerid, $extra) = @_;
636 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
638 if ($extra->{groupby}) {
639 $query .= " GROUP by $extra->{groupby}";
641 if ($extra->{orderby}){
642 $query .= " ORDER by $extra->{orderby}";
644 if ($extra->{limit}){
645 $query .= " LIMIT $extra->{limit}";
648 my $dbh = C4::Context->dbh;
649 my $sth = $dbh->prepare($query);
650 $sth->execute($booksellerid);
651 return $sth->fetchall_arrayref({});
654 =head3 GetBasketsInfosByBookseller
656 my $baskets = GetBasketsInfosByBookseller($supplierid, $allbaskets);
658 The optional second parameter allbaskets is a boolean allowing you to
659 select all baskets from the supplier; by default only active baskets (open or
660 closed but still something to receive) are returned.
662 Returns in a arrayref of hashref all about booksellers baskets, plus:
663 total_biblios: Number of distinct biblios in basket
664 total_items: Number of items in basket
665 expected_items: Number of non-received items in basket
669 sub GetBasketsInfosByBookseller {
670 my ($supplierid, $allbaskets) = @_;
672 return unless $supplierid;
674 my $dbh = C4::Context->dbh;
676 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,
677 SUM(aqorders.quantity) AS total_items,
679 IF ( aqorders.orderstatus = 'cancelled', aqorders.quantity, 0 )
680 ) AS total_items_cancelled,
681 COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
683 IF(aqorders.datereceived IS NULL
684 AND aqorders.datecancellationprinted IS NULL
688 SUM( aqorders.uncertainprice ) AS uncertainprices
690 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
691 WHERE booksellerid = ?};
693 $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";
695 unless ( $allbaskets ) {
696 # Don't show the basket if it's NOT CLOSED or is FULLY RECEIVED
697 $query.=" HAVING (closedate IS NULL OR (
699 IF(aqorders.datereceived IS NULL
700 AND aqorders.datecancellationprinted IS NULL
706 my $sth = $dbh->prepare($query);
707 $sth->execute($supplierid);
708 my $baskets = $sth->fetchall_arrayref({});
710 # Retrieve the number of biblios cancelled
711 my $cancelled_biblios = $dbh->selectall_hashref( q|
712 SELECT COUNT(DISTINCT(biblionumber)) AS total_biblios_cancelled, aqbasket.basketno
714 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
715 WHERE booksellerid = ?
716 AND aqorders.orderstatus = 'cancelled'
717 GROUP BY aqbasket.basketno
718 |, 'basketno', {}, $supplierid );
720 $_->{total_biblios_cancelled} = $cancelled_biblios->{$_->{basketno}}{total_biblios_cancelled} || 0
726 =head3 GetBasketUsers
728 $basketusers_ids = &GetBasketUsers($basketno);
730 Returns a list of all borrowernumbers that are in basket users list
735 my $basketno = shift;
737 return unless $basketno;
740 SELECT borrowernumber
744 my $dbh = C4::Context->dbh;
745 my $sth = $dbh->prepare($query);
746 $sth->execute($basketno);
747 my $results = $sth->fetchall_arrayref( {} );
750 foreach (@$results) {
751 push @borrowernumbers, $_->{'borrowernumber'};
754 return @borrowernumbers;
757 =head3 ModBasketUsers
759 my @basketusers_ids = (1, 2, 3);
760 &ModBasketUsers($basketno, @basketusers_ids);
762 Delete all users from basket users list, and add users in C<@basketusers_ids>
768 my ($basketno, @basketusers_ids) = @_;
770 return unless $basketno;
772 my $dbh = C4::Context->dbh;
774 DELETE FROM aqbasketusers
777 my $sth = $dbh->prepare($query);
778 $sth->execute($basketno);
781 INSERT INTO aqbasketusers (basketno, borrowernumber)
784 $sth = $dbh->prepare($query);
785 foreach my $basketuser_id (@basketusers_ids) {
786 $sth->execute($basketno, $basketuser_id);
789 # Log the basket update
790 if (C4::Context->preference("AcquisitionLog")) {
793 'MODIFY_BASKET_USERS',
796 basketno => $basketno,
797 basketusers => @basketusers_ids
805 =head3 CanUserManageBasket
807 my $bool = CanUserManageBasket($borrower, $basket[, $userflags]);
808 my $bool = CanUserManageBasket($borrowernumber, $basketno[, $userflags]);
810 Check if a borrower can manage a basket, according to system preference
811 AcqViewBaskets, user permissions and basket properties (creator, users list,
814 First parameter can be either a borrowernumber or a hashref as returned by
815 Koha::Patron->unblessed
817 Second parameter can be either a basketno or a hashref as returned by
818 C4::Acquisition::GetBasket.
820 The third parameter is optional. If given, it should be a hashref as returned
821 by C4::Auth::getuserflags. If not, getuserflags is called.
823 If user is authorised to manage basket, returns 1.
828 sub CanUserManageBasket {
829 my ($borrower, $basket, $userflags) = @_;
831 if (!ref $borrower) {
832 # FIXME This needs to be replaced
833 # We should not accept both scalar and array
834 # Tests need to be updated
835 $borrower = Koha::Patrons->find( $borrower )->unblessed;
838 $basket = GetBasket($basket);
841 return 0 unless ($basket and $borrower);
843 my $borrowernumber = $borrower->{borrowernumber};
844 my $basketno = $basket->{basketno};
846 my $AcqViewBaskets = C4::Context->preference('AcqViewBaskets');
848 if (!defined $userflags) {
849 my $dbh = C4::Context->dbh;
850 my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE borrowernumber = ?");
851 $sth->execute($borrowernumber);
852 my ($flags) = $sth->fetchrow_array;
855 $userflags = C4::Auth::getuserflags($flags, $borrower->{userid}, $dbh);
858 unless ($userflags->{superlibrarian}
859 || (ref $userflags->{acquisition} && $userflags->{acquisition}->{order_manage_all})
860 || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
862 if (not exists $userflags->{acquisition}) {
866 if ( (ref $userflags->{acquisition} && !$userflags->{acquisition}->{order_manage})
867 || (!ref $userflags->{acquisition} && !$userflags->{acquisition}) ) {
871 if ($AcqViewBaskets eq 'user'
872 && $basket->{authorisedby} != $borrowernumber
873 && ! grep { $borrowernumber eq $_ } GetBasketUsers($basketno)) {
877 if ($AcqViewBaskets eq 'branch' && defined $basket->{branch}
878 && $basket->{branch} ne $borrower->{branchcode}) {
886 #------------------------------------------------------------#
888 =head3 GetBasketsByBasketgroup
890 $baskets = &GetBasketsByBasketgroup($basketgroupid);
892 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
896 sub GetBasketsByBasketgroup {
897 my $basketgroupid = shift;
899 SELECT *, aqbasket.booksellerid as booksellerid
901 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?
903 my $dbh = C4::Context->dbh;
904 my $sth = $dbh->prepare($query);
905 $sth->execute($basketgroupid);
906 return $sth->fetchall_arrayref({});
909 #------------------------------------------------------------#
911 =head3 NewBasketgroup
913 $basketgroupid = NewBasketgroup(\%hashref);
915 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
917 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
919 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
921 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
923 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
925 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
927 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
929 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
931 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
936 my $basketgroupinfo = shift;
937 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
938 my $query = "INSERT INTO aqbasketgroups (";
940 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
941 if ( defined $basketgroupinfo->{$field} ) {
942 $query .= "$field, ";
943 push(@params, $basketgroupinfo->{$field});
946 $query .= "booksellerid) VALUES (";
951 push(@params, $basketgroupinfo->{'booksellerid'});
952 my $dbh = C4::Context->dbh;
953 my $sth = $dbh->prepare($query);
954 $sth->execute(@params);
955 my $basketgroupid = $dbh->{'mysql_insertid'};
956 if( $basketgroupinfo->{'basketlist'} ) {
957 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
958 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
959 my $sth2 = $dbh->prepare($query2);
960 $sth2->execute($basketgroupid, $basketno);
963 return $basketgroupid;
966 #------------------------------------------------------------#
968 =head3 ModBasketgroup
970 ModBasketgroup(\%hashref);
972 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
974 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
976 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
978 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
980 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
982 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
984 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
986 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
988 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
993 my $basketgroupinfo = shift;
994 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
995 my $dbh = C4::Context->dbh;
996 my $query = "UPDATE aqbasketgroups SET ";
998 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
999 if ( defined $basketgroupinfo->{$field} ) {
1000 $query .= "$field=?, ";
1001 push(@params, $basketgroupinfo->{$field});
1006 $query .= " WHERE id=?";
1007 push(@params, $basketgroupinfo->{'id'});
1008 my $sth = $dbh->prepare($query);
1009 $sth->execute(@params);
1011 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
1012 $sth->execute($basketgroupinfo->{'id'});
1014 if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
1015 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
1016 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
1017 $sth->execute($basketgroupinfo->{'id'}, $basketno);
1023 #------------------------------------------------------------#
1025 =head3 DelBasketgroup
1027 DelBasketgroup($basketgroupid);
1029 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
1033 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
1039 sub DelBasketgroup {
1040 my $basketgroupid = shift;
1041 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1042 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
1043 my $dbh = C4::Context->dbh;
1044 my $sth = $dbh->prepare($query);
1045 $sth->execute($basketgroupid);
1049 #------------------------------------------------------------#
1052 =head2 FUNCTIONS ABOUT ORDERS
1054 =head3 GetBasketgroup
1056 $basketgroup = &GetBasketgroup($basketgroupid);
1058 Returns a reference to the hash containing all information about the basketgroup.
1062 sub GetBasketgroup {
1063 my $basketgroupid = shift;
1064 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1065 my $dbh = C4::Context->dbh;
1066 my $result_set = $dbh->selectall_arrayref(
1067 'SELECT * FROM aqbasketgroups WHERE id=?',
1071 return $result_set->[0]; # id is unique
1074 #------------------------------------------------------------#
1076 =head3 GetBasketgroups
1078 $basketgroups = &GetBasketgroups($booksellerid);
1080 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
1084 sub GetBasketgroups {
1085 my $booksellerid = shift;
1086 die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
1087 my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
1088 my $dbh = C4::Context->dbh;
1089 my $sth = $dbh->prepare($query);
1090 $sth->execute($booksellerid);
1091 return $sth->fetchall_arrayref({});
1094 #------------------------------------------------------------#
1096 =head2 FUNCTIONS ABOUT ORDERS
1100 @orders = &GetOrders( $basketno, { orderby => 'biblio.title', cancelled => 0|1 } );
1102 Looks up the pending (non-cancelled) orders with the given basket
1105 If cancelled is set, only cancelled orders will be returned.
1110 my ( $basketno, $params ) = @_;
1112 return () unless $basketno;
1114 my $orderby = $params->{orderby};
1115 my $cancelled = $params->{cancelled} || 0;
1117 my $dbh = C4::Context->dbh;
1119 SELECT biblio.*,biblioitems.*,
1123 $query .= $cancelled
1125 aqorders_transfers.ordernumber_to AS transferred_to,
1126 aqorders_transfers.timestamp AS transferred_to_timestamp
1129 aqorders_transfers.ordernumber_from AS transferred_from,
1130 aqorders_transfers.timestamp AS transferred_from_timestamp
1134 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1135 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1136 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1138 $query .= $cancelled
1140 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
1143 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1151 $orderby ||= q|biblioitems.publishercode, biblio.title|;
1153 AND datecancellationprinted IS NOT NULL
1158 q|aqorders.datecancellationprinted desc, aqorders.timestamp desc|;
1160 AND datecancellationprinted IS NULL
1164 $query .= " ORDER BY $orderby";
1166 $dbh->selectall_arrayref( $query, { Slice => {} }, $basketno );
1171 #------------------------------------------------------------#
1173 =head3 GetOrdersByBiblionumber
1175 @orders = &GetOrdersByBiblionumber($biblionumber);
1177 Looks up the orders with linked to a specific $biblionumber, including
1178 cancelled orders and received orders.
1181 C<@orders> is an array of references-to-hash, whose keys are the
1182 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
1186 sub GetOrdersByBiblionumber {
1187 my $biblionumber = shift;
1188 return unless $biblionumber;
1189 my $dbh = C4::Context->dbh;
1191 SELECT biblio.*,biblioitems.*,
1195 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1196 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1197 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1198 WHERE aqorders.biblionumber=?
1201 $dbh->selectall_arrayref( $query, { Slice => {} }, $biblionumber );
1202 return @{$result_set};
1206 #------------------------------------------------------------#
1210 $order = &GetOrder($ordernumber);
1212 Looks up an order by order number.
1214 Returns a reference-to-hash describing the order. The keys of
1215 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1220 my ($ordernumber) = @_;
1221 return unless $ordernumber;
1223 my $dbh = C4::Context->dbh;
1224 my $query = qq{SELECT
1228 aqbasket.basketname,
1229 borrowers.branchcode,
1230 biblioitems.publicationyear,
1231 biblio.copyrightdate,
1232 biblioitems.editionstatement,
1236 biblioitems.publishercode,
1237 aqorders.rrp AS unitpricesupplier,
1238 aqorders.ecost AS unitpricelib,
1239 aqbudgets.budget_name AS budget,
1240 aqbooksellers.name AS supplier,
1241 aqbooksellers.id AS supplierid,
1242 biblioitems.publishercode AS publisher,
1243 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1244 DATE(aqbasket.closedate) AS orderdate,
1245 aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity_to_receive,
1246 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1247 DATEDIFF(CURDATE( ),closedate) AS latesince
1248 FROM aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1249 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1250 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1251 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
1252 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1253 WHERE aqorders.basketno = aqbasket.basketno
1256 $dbh->selectall_arrayref( $query, { Slice => {} }, $ordernumber );
1258 # result_set assumed to contain 1 match
1259 return $result_set->[0];
1264 &ModOrder(\%hashref);
1266 Modifies an existing order. Updates the order with order number
1267 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1268 other keys of the hash update the fields with the same name in the aqorders
1269 table of the Koha database.
1274 my $orderinfo = shift;
1276 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '';
1278 my $dbh = C4::Context->dbh;
1281 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1282 $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1284 # delete($orderinfo->{'branchcode'});
1285 # the hash contains a lot of entries not in aqorders, so get the columns ...
1286 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1288 my $colnames = $sth->{NAME};
1289 #FIXME Be careful. If aqorders would have columns with diacritics,
1290 #you should need to decode what you get back from NAME.
1291 #See report 10110 and guided_reports.pl
1292 my $query = "UPDATE aqorders SET ";
1294 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1295 # ... and skip hash entries that are not in the aqorders table
1296 # FIXME : probably not the best way to do it (would be better to have a correct hash)
1297 next unless grep { $_ eq $orderinfokey } @$colnames;
1298 $query .= "$orderinfokey=?, ";
1299 push(@params, $orderinfo->{$orderinfokey});
1302 $query .= "timestamp=NOW() WHERE ordernumber=?";
1303 push(@params, $orderinfo->{'ordernumber'} );
1304 $sth = $dbh->prepare($query);
1305 $sth->execute(@params);
1309 #------------------------------------------------------------#
1313 ModItemOrder($itemnumber, $ordernumber);
1315 Modifies the ordernumber of an item in aqorders_items.
1320 my ($itemnumber, $ordernumber) = @_;
1322 return unless ($itemnumber and $ordernumber);
1324 my $dbh = C4::Context->dbh;
1326 UPDATE aqorders_items
1328 WHERE itemnumber = ?
1330 my $sth = $dbh->prepare($query);
1331 return $sth->execute($ordernumber, $itemnumber);
1334 #------------------------------------------------------------#
1336 =head3 ModReceiveOrder
1338 my ( $date_received, $new_ordernumber ) = ModReceiveOrder(
1340 biblionumber => $biblionumber,
1342 quantityreceived => $quantityreceived,
1344 invoice => $invoice,
1345 budget_id => $budget_id,
1346 datereceived => $datereceived,
1347 received_itemnumbers => \@received_itemnumbers,
1351 Updates an order, to reflect the fact that it was received, at least
1354 If a partial order is received, splits the order into two.
1356 Updates the order with biblionumber C<$biblionumber> and ordernumber
1357 C<$order->{ordernumber}>.
1362 sub ModReceiveOrder {
1364 my $biblionumber = $params->{biblionumber};
1365 my $order = { %{ $params->{order} } }; # Copy the order, we don't want to modify it
1366 my $invoice = $params->{invoice};
1367 my $quantrec = $params->{quantityreceived};
1368 my $user = $params->{user};
1369 my $budget_id = $params->{budget_id};
1370 my $datereceived = $params->{datereceived};
1371 my $received_items = $params->{received_items};
1373 my $dbh = C4::Context->dbh;
1374 $datereceived = output_pref(
1376 dt => ( $datereceived ? dt_from_string( $datereceived ) : dt_from_string ),
1377 dateformat => 'iso',
1382 my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1383 if ($suggestionid) {
1384 ModSuggestion( {suggestionid=>$suggestionid,
1385 STATUS=>'AVAILABLE',
1386 biblionumber=> $biblionumber}
1390 my $result_set = $dbh->selectrow_arrayref(
1391 q{SELECT aqbasket.is_standing
1393 WHERE basketno=?},{ Slice => {} }, $order->{basketno});
1394 my $is_standing = $result_set->[0]; # we assume we have a unique basket
1396 my $new_ordernumber = $order->{ordernumber};
1397 if ( $is_standing || $order->{quantity} > $quantrec ) {
1398 # Split order line in two parts: the first is the original order line
1399 # without received items (the quantity is decreased),
1400 # the second part is a new order line with quantity=quantityrec
1401 # (entirely received)
1405 orderstatus = 'partial'|;
1406 $query .= q| WHERE ordernumber = ?|;
1407 my $sth = $dbh->prepare($query);
1410 ( $is_standing ? 1 : ($order->{quantity} - $quantrec) ),
1411 $order->{ordernumber}
1414 if ( not $order->{subscriptionid} && defined $order->{order_internalnote} ) {
1417 SET order_internalnote = ?
1418 WHERE ordernumber = ?|, {},
1419 $order->{order_internalnote}, $order->{ordernumber}
1423 # Recalculate tax_value
1427 tax_value_on_ordering = quantity * | . get_rounding_sql(q|ecost_tax_excluded|) . q| * tax_rate_on_ordering,
1428 tax_value_on_receiving = quantity * | . get_rounding_sql(q|unitprice_tax_excluded|) . q| * tax_rate_on_receiving
1429 WHERE ordernumber = ?
1430 |, undef, $order->{ordernumber});
1432 delete $order->{ordernumber};
1433 $order->{budget_id} = ( $budget_id || $order->{budget_id} );
1434 $order->{quantity} = $quantrec;
1435 $order->{quantityreceived} = $quantrec;
1436 $order->{ecost_tax_excluded} //= 0;
1437 $order->{tax_rate_on_ordering} //= 0;
1438 $order->{unitprice_tax_excluded} //= 0;
1439 $order->{tax_rate_on_receiving} //= 0;
1440 $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($order->{ecost_tax_excluded}) * $order->{tax_rate_on_ordering};
1441 $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
1442 $order->{datereceived} = $datereceived;
1443 $order->{invoiceid} = $invoice->{invoiceid};
1444 $order->{orderstatus} = 'complete';
1445 $new_ordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber; # TODO What if the store fails?
1447 if ($received_items) {
1448 foreach my $itemnumber (@$received_items) {
1449 ModItemOrder($itemnumber, $new_ordernumber);
1455 SET quantityreceived = ?,
1459 orderstatus = 'complete'
1463 , replacementprice = ?
1464 | if defined $order->{replacementprice};
1467 , unitprice = ?, unitprice_tax_included = ?, unitprice_tax_excluded = ?
1468 | if defined $order->{unitprice};
1471 ,tax_value_on_receiving = ?
1472 | if defined $order->{tax_value_on_receiving};
1475 ,tax_rate_on_receiving = ?
1476 | if defined $order->{tax_rate_on_receiving};
1479 , order_internalnote = ?
1480 | if defined $order->{order_internalnote};
1482 $query .= q| where biblionumber=? and ordernumber=?|;
1484 my $sth = $dbh->prepare( $query );
1485 my @params = ( $quantrec, $datereceived, $invoice->{invoiceid}, ( $budget_id ? $budget_id : $order->{budget_id} ) );
1487 if ( defined $order->{replacementprice} ) {
1488 push @params, $order->{replacementprice};
1491 if ( defined $order->{unitprice} ) {
1492 push @params, $order->{unitprice}, $order->{unitprice_tax_included}, $order->{unitprice_tax_excluded};
1495 if ( defined $order->{tax_value_on_receiving} ) {
1496 push @params, $order->{tax_value_on_receiving};
1499 if ( defined $order->{tax_rate_on_receiving} ) {
1500 push @params, $order->{tax_rate_on_receiving};
1503 if ( defined $order->{order_internalnote} ) {
1504 push @params, $order->{order_internalnote};
1507 push @params, ( $biblionumber, $order->{ordernumber} );
1509 $sth->execute( @params );
1511 # All items have been received, sent a notification to users
1512 NotifyOrderUsers( $order->{ordernumber} );
1515 return ($datereceived, $new_ordernumber);
1518 =head3 CancelReceipt
1520 my $parent_ordernumber = CancelReceipt($ordernumber);
1522 Cancel an order line receipt and update the parent order line, as if no
1524 If items are created at receipt (AcqCreateItem = receiving) then delete
1530 my $ordernumber = shift;
1532 return unless $ordernumber;
1534 my $dbh = C4::Context->dbh;
1536 SELECT datereceived, parent_ordernumber, quantity
1538 WHERE ordernumber = ?
1540 my $sth = $dbh->prepare($query);
1541 $sth->execute($ordernumber);
1542 my $order = $sth->fetchrow_hashref;
1544 warn "CancelReceipt: order $ordernumber does not exist";
1547 unless($order->{'datereceived'}) {
1548 warn "CancelReceipt: order $ordernumber is not received";
1552 my $parent_ordernumber = $order->{'parent_ordernumber'};
1554 my $order_obj = Koha::Acquisition::Orders->find( $ordernumber ); # FIXME rewrite all this subroutine using this object
1555 my @itemnumbers = $order_obj->items->get_column('itemnumber');
1557 if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1558 # The order line has no parent, just mark it as not received
1561 SET quantityreceived = ?,
1564 orderstatus = 'ordered'
1565 WHERE ordernumber = ?
1567 $sth = $dbh->prepare($query);
1568 $sth->execute(0, undef, undef, $ordernumber);
1569 _cancel_items_receipt( $order_obj );
1571 # The order line has a parent, increase parent quantity and delete
1573 unless ( $order_obj->basket->is_standing ) {
1575 SELECT quantity, datereceived
1577 WHERE ordernumber = ?
1579 $sth = $dbh->prepare($query);
1580 $sth->execute($parent_ordernumber);
1581 my $parent_order = $sth->fetchrow_hashref;
1582 unless($parent_order) {
1583 warn "Parent order $parent_ordernumber does not exist.";
1586 if($parent_order->{'datereceived'}) {
1587 warn "CancelReceipt: parent order is received.".
1588 " Can't cancel receipt.";
1594 orderstatus = 'ordered'
1595 WHERE ordernumber = ?
1597 $sth = $dbh->prepare($query);
1598 my $rv = $sth->execute(
1599 $order->{'quantity'} + $parent_order->{'quantity'},
1603 warn "Cannot update parent order line, so do not cancel".
1608 # Recalculate tax_value
1612 tax_value_on_ordering = quantity * | . get_rounding_sql(q|ecost_tax_excluded|) . q| * tax_rate_on_ordering,
1613 tax_value_on_receiving = quantity * | . get_rounding_sql(q|unitprice_tax_excluded|) . q| * tax_rate_on_receiving
1614 WHERE ordernumber = ?
1615 |, undef, $parent_ordernumber);
1618 _cancel_items_receipt( $order_obj, $parent_ordernumber );
1621 DELETE FROM aqorders
1622 WHERE ordernumber = ?
1624 $sth = $dbh->prepare($query);
1625 $sth->execute($ordernumber);
1629 if( $order_obj->basket->effective_create_items eq 'ordering' ) {
1630 my @affects = split q{\|}, C4::Context->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1632 for my $in ( @itemnumbers ) {
1633 my $item = Koha::Items->find( $in ); # FIXME We do not need that, we already have Koha::Items from $order_obj->items
1634 my $biblio = $item->biblio;
1635 my ( $itemfield ) = GetMarcFromKohaField( 'items.itemnumber' );
1636 my $item_marc = C4::Items::GetMarcItem( $biblio->biblionumber, $in );
1637 for my $affect ( @affects ) {
1638 my ( $sf, $v ) = split q{=}, $affect, 2;
1639 foreach ( $item_marc->field($itemfield) ) {
1640 $_->update( $sf => $v );
1643 C4::Items::ModItemFromMarc( $item_marc, $biblio->biblionumber, $in );
1648 return $parent_ordernumber;
1651 sub _cancel_items_receipt {
1652 my ( $order, $parent_ordernumber ) = @_;
1653 $parent_ordernumber ||= $order->ordernumber;
1655 my $items = $order->items;
1656 if ( $order->basket->effective_create_items eq 'receiving' ) {
1657 # Remove items that were created at receipt
1659 DELETE FROM items, aqorders_items
1660 USING items, aqorders_items
1661 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1663 my $dbh = C4::Context->dbh;
1664 my $sth = $dbh->prepare($query);
1665 while ( my $item = $items->next ) {
1666 $sth->execute($item->itemnumber, $item->itemnumber);
1670 while ( my $item = $items->next ) {
1671 ModItemOrder($item->itemnumber, $parent_ordernumber);
1676 #------------------------------------------------------------#
1680 @results = &SearchOrders({
1681 ordernumber => $ordernumber,
1684 booksellerid => $booksellerid,
1685 basketno => $basketno,
1686 basketname => $basketname,
1687 basketgroupname => $basketgroupname,
1691 biblionumber => $biblionumber,
1692 budget_id => $budget_id
1695 Searches for orders filtered by criteria.
1697 C<$ordernumber> Finds matching orders or transferred orders by ordernumber.
1698 C<$search> Finds orders matching %$search% in title, author, or isbn.
1699 C<$owner> Finds order for the logged in user.
1700 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1701 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1704 C<@results> is an array of references-to-hash with the keys are fields
1705 from aqorders, biblio, biblioitems and aqbasket tables.
1710 my ( $params ) = @_;
1711 my $ordernumber = $params->{ordernumber};
1712 my $search = $params->{search};
1713 my $ean = $params->{ean};
1714 my $booksellerid = $params->{booksellerid};
1715 my $basketno = $params->{basketno};
1716 my $basketname = $params->{basketname};
1717 my $basketgroupname = $params->{basketgroupname};
1718 my $owner = $params->{owner};
1719 my $pending = $params->{pending};
1720 my $ordered = $params->{ordered};
1721 my $biblionumber = $params->{biblionumber};
1722 my $budget_id = $params->{budget_id};
1724 my $dbh = C4::Context->dbh;
1727 SELECT aqbasket.basketno,
1729 borrowers.firstname,
1732 biblioitems.biblioitemnumber,
1733 biblioitems.publishercode,
1734 biblioitems.publicationyear,
1735 aqbasket.authorisedby,
1736 aqbasket.booksellerid,
1738 aqbasket.creationdate,
1739 aqbasket.basketname,
1740 aqbasketgroups.id as basketgroupid,
1741 aqbasketgroups.name as basketgroupname,
1744 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1745 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1746 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1747 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1748 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1751 # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
1753 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1757 WHERE (datecancellationprinted is NULL)
1760 if ( $pending or $ordered ) {
1763 ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) )
1765 ( quantity > quantityreceived OR quantityreceived is NULL )
1769 $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1777 my $userenv = C4::Context->userenv;
1778 if ( C4::Context->preference("IndependentBranches") ) {
1779 unless ( C4::Context->IsSuperLibrarian() ) {
1782 borrowers.branchcode = ?
1783 OR borrowers.branchcode = ''
1786 push @args, $userenv->{branch};
1790 if ( $ordernumber ) {
1791 $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1792 push @args, ( $ordernumber, $ordernumber );
1794 if ( $biblionumber ) {
1795 $query .= 'AND aqorders.biblionumber = ?';
1796 push @args, $biblionumber;
1799 $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1800 push @args, ("%$search%","%$search%","%$search%");
1803 $query .= ' AND biblioitems.ean = ?';
1806 if ( $booksellerid ) {
1807 $query .= 'AND aqbasket.booksellerid = ?';
1808 push @args, $booksellerid;
1811 $query .= 'AND aqbasket.basketno = ?';
1812 push @args, $basketno;
1815 $query .= 'AND aqbasket.basketname LIKE ?';
1816 push @args, "%$basketname%";
1818 if( $basketgroupname ) {
1819 $query .= ' AND aqbasketgroups.name LIKE ?';
1820 push @args, "%$basketgroupname%";
1824 $query .= ' AND aqbasket.authorisedby=? ';
1825 push @args, $userenv->{'number'};
1829 $query .= ' AND aqorders.budget_id = ?';
1830 push @args, $budget_id;
1833 $query .= ' ORDER BY aqbasket.basketno';
1835 my $sth = $dbh->prepare($query);
1836 $sth->execute(@args);
1837 return $sth->fetchall_arrayref({});
1840 #------------------------------------------------------------#
1842 =head3 TransferOrder
1844 my $newordernumber = TransferOrder($ordernumber, $basketno);
1846 Transfer an order line to a basket.
1847 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1848 to BOOKSELLER on DATE' and create new order with internal note
1849 'Transferred from BOOKSELLER on DATE'.
1850 Move all attached items to the new order.
1851 Received orders cannot be transferred.
1852 Return the ordernumber of created order.
1857 my ($ordernumber, $basketno) = @_;
1859 return unless ($ordernumber and $basketno);
1861 my $order = Koha::Acquisition::Orders->find( $ordernumber ) or return;
1862 return if $order->datereceived;
1864 $order = $order->unblessed;
1866 my $basket = GetBasket($basketno);
1867 return unless $basket;
1869 my $dbh = C4::Context->dbh;
1870 my ($query, $sth, $rv);
1874 SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1875 WHERE ordernumber = ?
1877 $sth = $dbh->prepare($query);
1878 $rv = $sth->execute('cancelled', $ordernumber);
1880 delete $order->{'ordernumber'};
1881 delete $order->{parent_ordernumber};
1882 $order->{'basketno'} = $basketno;
1884 my $newordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber;
1887 UPDATE aqorders_items
1889 WHERE ordernumber = ?
1891 $sth = $dbh->prepare($query);
1892 $sth->execute($newordernumber, $ordernumber);
1895 INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1898 $sth = $dbh->prepare($query);
1899 $sth->execute($ordernumber, $newordernumber);
1901 return $newordernumber;
1904 =head3 get_rounding_sql
1906 $rounding_sql = get_rounding_sql($column_name);
1908 returns the correct SQL routine based on OrderPriceRounding system preference.
1912 sub get_rounding_sql {
1913 my ( $round_string ) = @_;
1914 my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
1915 if ( $rounding_pref eq "nearest_cent" ) {
1916 return "CAST($round_string*100 AS SIGNED)/100";
1918 return $round_string;
1921 =head3 get_rounded_price
1923 $rounded_price = get_rounded_price( $price );
1925 returns a price rounded as specified in OrderPriceRounding system preference.
1929 sub get_rounded_price {
1931 my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
1932 if( $rounding_pref eq 'nearest_cent' ) {
1933 return Koha::Number::Price->new( $price )->round();
1939 =head2 FUNCTIONS ABOUT PARCELS
1943 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1945 get a lists of parcels.
1952 is the bookseller this function has to get parcels.
1955 To know on what criteria the results list has to be ordered.
1958 is the booksellerinvoicenumber.
1960 =item $datefrom & $dateto
1961 to know on what date this function has to filter its search.
1966 a pointer on a hash list containing parcel informations as such :
1972 =item Last operation
1974 =item Number of biblio
1976 =item Number of items
1983 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1984 my $dbh = C4::Context->dbh;
1985 my @query_params = ();
1987 SELECT aqinvoices.invoicenumber,
1988 datereceived,purchaseordernumber,
1989 count(DISTINCT biblionumber) AS biblio,
1990 sum(quantity) AS itemsexpected,
1991 sum(quantityreceived) AS itemsreceived
1992 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1993 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1994 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1996 push @query_params, $bookseller;
1998 if ( defined $code ) {
1999 $strsth .= ' and aqinvoices.invoicenumber like ? ';
2000 # add a % to the end of the code to allow stemming.
2001 push @query_params, "$code%";
2004 if ( defined $datefrom ) {
2005 $strsth .= ' and datereceived >= ? ';
2006 push @query_params, $datefrom;
2009 if ( defined $dateto ) {
2010 $strsth .= 'and datereceived <= ? ';
2011 push @query_params, $dateto;
2014 $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
2016 # can't use a placeholder to place this column name.
2017 # but, we could probably be checking to make sure it is a column that will be fetched.
2018 $strsth .= "order by $order " if ($order);
2020 my $sth = $dbh->prepare($strsth);
2022 $sth->execute( @query_params );
2023 my $results = $sth->fetchall_arrayref({});
2027 #------------------------------------------------------------#
2031 \@order_loop = GetHistory( %params );
2033 Retreives some acquisition history information
2043 basket - search both basket name and number
2044 booksellerinvoicenumber
2047 orderstatus (note that orderstatus '' will retrieve orders
2048 of any status except cancelled)
2052 get_canceled_order (if set to a true value, cancelled orders will
2056 $order_loop is a list of hashrefs that each look like this:
2058 'author' => 'Twain, Mark',
2060 'biblionumber' => '215',
2062 'creationdate' => 'MM/DD/YYYY',
2063 'datereceived' => undef,
2066 'invoicenumber' => undef,
2068 'ordernumber' => '1',
2070 'quantityreceived' => undef,
2071 'title' => 'The Adventures of Huckleberry Finn',
2072 'managing_library' => 'CPL'
2073 'is_standing' => '1'
2079 # don't run the query if there are no parameters (list would be too long for sure !)
2080 croak "No search params" unless @_;
2082 my $title = $params{title};
2083 my $author = $params{author};
2084 my $isbn = $params{isbn};
2085 my $ean = $params{ean};
2086 my $name = $params{name};
2087 my $from_placed_on = $params{from_placed_on};
2088 my $to_placed_on = $params{to_placed_on};
2089 my $basket = $params{basket};
2090 my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2091 my $basketgroupname = $params{basketgroupname};
2092 my $budget = $params{budget};
2093 my $orderstatus = $params{orderstatus};
2094 my $is_standing = $params{is_standing};
2095 my $biblionumber = $params{biblionumber};
2096 my $get_canceled_order = $params{get_canceled_order} || 0;
2097 my $ordernumber = $params{ordernumber};
2098 my $search_children_too = $params{search_children_too} || 0;
2099 my $created_by = $params{created_by} || [];
2100 my $managing_library = $params{managing_library};
2101 my $ordernumbers = $params{ordernumbers} || [];
2102 my $additional_fields = $params{additional_fields} // [];
2105 my $total_qtyreceived = 0;
2106 my $total_price = 0;
2108 #get variation of isbn
2112 if ( C4::Context->preference("SearchWithISBNVariations") ){
2113 @isbns = C4::Koha::GetVariationsOfISBN( $isbn );
2114 foreach my $isb (@isbns){
2115 push @isbn_params, '?';
2120 push @isbn_params, '?';
2124 my $dbh = C4::Context->dbh;
2127 COALESCE(biblio.title, deletedbiblio.title) AS title,
2128 COALESCE(biblio.author, deletedbiblio.author) AS author,
2129 COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2130 COALESCE(biblioitems.ean, deletedbiblioitems.ean) AS ean,
2132 aqbasket.basketname,
2133 aqbasket.basketgroupid,
2134 aqbasket.authorisedby,
2135 aqbasket.is_standing,
2136 concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2137 branch as managing_library,
2138 aqbasketgroups.name as groupname,
2140 aqbasket.creationdate,
2141 aqorders.datereceived,
2143 aqorders.quantityreceived,
2145 aqorders.ordernumber,
2147 aqinvoices.invoicenumber,
2148 aqbooksellers.id as id,
2149 aqorders.biblionumber,
2150 aqorders.orderstatus,
2151 aqorders.parent_ordernumber,
2152 aqbudgets.budget_name
2154 $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2157 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2158 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2159 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2160 LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2161 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2162 LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2163 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2164 LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2165 LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2166 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2169 $query .= " WHERE 1 ";
2171 unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2172 $query .= " AND datecancellationprinted IS NULL ";
2175 my @query_params = ();
2177 if ( $biblionumber ) {
2178 $query .= " AND biblio.biblionumber = ?";
2179 push @query_params, $biblionumber;
2183 $query .= " AND biblio.title LIKE ? ";
2184 $title =~ s/\s+/%/g;
2185 push @query_params, "%$title%";
2189 $query .= " AND biblio.author LIKE ? ";
2190 push @query_params, "%$author%";
2194 $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2195 foreach my $isb (@isbns){
2196 push @query_params, "%$isb%";
2201 $query .= " AND biblioitems.ean = ? ";
2202 push @query_params, "$ean";
2205 $query .= " AND aqbooksellers.name LIKE ? ";
2206 push @query_params, "%$name%";
2210 $query .= " AND aqbudgets.budget_id = ? ";
2211 push @query_params, "$budget";
2214 if ( $from_placed_on ) {
2215 $query .= " AND creationdate >= ? ";
2216 push @query_params, $from_placed_on;
2219 if ( $to_placed_on ) {
2220 $query .= " AND creationdate <= ? ";
2221 push @query_params, $to_placed_on;
2224 if ( defined $orderstatus and $orderstatus ne '') {
2225 $query .= " AND aqorders.orderstatus = ? ";
2226 push @query_params, "$orderstatus";
2229 if ( $is_standing ) {
2230 $query .= " AND is_standing = ? ";
2231 push @query_params, $is_standing;
2235 if ($basket =~ m/^\d+$/) {
2236 $query .= " AND aqorders.basketno = ? ";
2237 push @query_params, $basket;
2239 $query .= " AND aqbasket.basketname LIKE ? ";
2240 push @query_params, "%$basket%";
2244 if ($booksellerinvoicenumber) {
2245 $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2246 push @query_params, "%$booksellerinvoicenumber%";
2249 if ($basketgroupname) {
2250 $query .= " AND aqbasketgroups.name LIKE ? ";
2251 push @query_params, "%$basketgroupname%";
2255 $query .= " AND (aqorders.ordernumber = ? ";
2256 push @query_params, $ordernumber;
2257 if ($search_children_too) {
2258 $query .= " OR aqorders.parent_ordernumber = ? ";
2259 push @query_params, $ordernumber;
2264 if ( @$created_by ) {
2265 $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2266 push @query_params, @$created_by;
2269 if ( $managing_library ) {
2270 $query .= " AND aqbasket.branch = ? ";
2271 push @query_params, $managing_library;
2274 if ( @$ordernumbers ) {
2275 $query .= ' AND (aqorders.ordernumber IN ( ' . join (',', ('?') x @$ordernumbers ) . '))';
2276 push @query_params, @$ordernumbers;
2278 if ( @$additional_fields ) {
2279 my @baskets = Koha::Acquisition::Baskets->filter_by_additional_fields($additional_fields);
2281 return [] unless @baskets;
2283 # No parameterization because record IDs come directly from DB
2284 $query .= ' AND aqbasket.basketno IN ( ' . join( ',', map { $_->basketno } @baskets ) . ' )';
2287 if ( C4::Context->preference("IndependentBranches") ) {
2288 unless ( C4::Context->IsSuperLibrarian() ) {
2289 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2290 push @query_params, C4::Context->userenv->{branch};
2293 $query .= " ORDER BY id";
2295 return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2298 =head2 GetRecentAcqui
2300 $results = GetRecentAcqui($days);
2302 C<$results> is a ref to a table which contains hashref
2306 sub GetRecentAcqui {
2308 my $dbh = C4::Context->dbh;
2312 ORDER BY timestamp DESC
2315 my $sth = $dbh->prepare($query);
2317 my $results = $sth->fetchall_arrayref({});
2321 #------------------------------------------------------------#
2325 &AddClaim($ordernumber);
2327 Add a claim for an order
2332 my ($ordernumber) = @_;
2333 my $dbh = C4::Context->dbh;
2336 claims_count = claims_count + 1,
2337 claimed_date = CURDATE()
2338 WHERE ordernumber = ?
2340 my $sth = $dbh->prepare($query);
2341 $sth->execute($ordernumber);
2346 my @invoices = GetInvoices(
2347 invoicenumber => $invoicenumber,
2348 supplierid => $supplierid,
2349 suppliername => $suppliername,
2350 shipmentdatefrom => $shipmentdatefrom, # ISO format
2351 shipmentdateto => $shipmentdateto, # ISO format
2352 billingdatefrom => $billingdatefrom, # ISO format
2353 billingdateto => $billingdateto, # ISO format
2354 isbneanissn => $isbn_or_ean_or_issn,
2357 publisher => $publisher,
2358 publicationyear => $publicationyear,
2359 branchcode => $branchcode,
2360 order_by => $order_by
2363 Return a list of invoices that match all given criteria.
2365 $order_by is "column_name (asc|desc)", where column_name is any of
2366 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2367 'shipmentcost', 'shipmentcost_budgetid'.
2369 asc is the default if omitted
2376 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2377 closedate shipmentcost shipmentcost_budgetid);
2379 my $dbh = C4::Context->dbh;
2381 SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
2382 aqbooksellers.name AS suppliername,
2385 aqorders.datereceived IS NOT NULL,
2386 aqorders.biblionumber,
2389 ) AS receivedbiblios,
2392 aqorders.subscriptionid IS NOT NULL,
2393 aqorders.subscriptionid,
2396 ) AS is_linked_to_subscriptions,
2397 SUM(aqorders.quantityreceived) AS receiveditems
2399 LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2400 LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2401 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2402 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2403 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2404 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2405 LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2410 if($args{supplierid}) {
2411 push @bind_strs, " aqinvoices.booksellerid = ? ";
2412 push @bind_args, $args{supplierid};
2414 if($args{invoicenumber}) {
2415 push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2416 push @bind_args, "%$args{invoicenumber}%";
2418 if($args{suppliername}) {
2419 push @bind_strs, " aqbooksellers.name LIKE ? ";
2420 push @bind_args, "%$args{suppliername}%";
2422 if($args{shipmentdatefrom}) {
2423 push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2424 push @bind_args, $args{shipmentdatefrom};
2426 if($args{shipmentdateto}) {
2427 push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2428 push @bind_args, $args{shipmentdateto};
2430 if($args{billingdatefrom}) {
2431 push @bind_strs, " aqinvoices.billingdate >= ? ";
2432 push @bind_args, $args{billingdatefrom};
2434 if($args{billingdateto}) {
2435 push @bind_strs, " aqinvoices.billingdate <= ? ";
2436 push @bind_args, $args{billingdateto};
2438 if($args{isbneanissn}) {
2439 push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2440 push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2443 push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2444 push @bind_args, $args{title};
2447 push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2448 push @bind_args, $args{author};
2450 if($args{publisher}) {
2451 push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2452 push @bind_args, $args{publisher};
2454 if($args{publicationyear}) {
2455 push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2456 push @bind_args, $args{publicationyear}, $args{publicationyear};
2458 if($args{branchcode}) {
2459 push @bind_strs, " borrowers.branchcode = ? ";
2460 push @bind_args, $args{branchcode};
2462 if($args{message_id}) {
2463 push @bind_strs, " aqinvoices.message_id = ? ";
2464 push @bind_args, $args{message_id};
2467 $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2468 $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";
2470 if($args{order_by}) {
2471 my ($column, $direction) = split / /, $args{order_by};
2472 if(grep { $_ eq $column } @columns) {
2473 $direction ||= 'ASC';
2474 $query .= " ORDER BY $column $direction";
2478 my $sth = $dbh->prepare($query);
2479 $sth->execute(@bind_args);
2481 my $results = $sth->fetchall_arrayref({});
2487 my $invoice = GetInvoice($invoiceid);
2489 Get informations about invoice with given $invoiceid
2491 Return a hash filled with aqinvoices.* fields
2496 my ($invoiceid) = @_;
2499 return unless $invoiceid;
2501 my $dbh = C4::Context->dbh;
2507 my $sth = $dbh->prepare($query);
2508 $sth->execute($invoiceid);
2510 $invoice = $sth->fetchrow_hashref;
2514 =head3 GetInvoiceDetails
2516 my $invoice = GetInvoiceDetails($invoiceid)
2518 Return informations about an invoice + the list of related order lines
2520 Orders informations are in $invoice->{orders} (array ref)
2524 sub GetInvoiceDetails {
2525 my ($invoiceid) = @_;
2527 if ( !defined $invoiceid ) {
2528 carp 'GetInvoiceDetails called without an invoiceid';
2532 my $dbh = C4::Context->dbh;
2534 SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2536 LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2539 my $sth = $dbh->prepare($query);
2540 $sth->execute($invoiceid);
2542 my $invoice = $sth->fetchrow_hashref;
2547 biblio.copyrightdate,
2549 biblioitems.publishercode,
2550 biblioitems.publicationyear,
2551 aqbasket.basketname,
2552 aqbasketgroups.id AS basketgroupid,
2553 aqbasketgroups.name AS basketgroupname
2555 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2556 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2557 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2558 LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2561 $sth = $dbh->prepare($query);
2562 $sth->execute($invoiceid);
2563 $invoice->{orders} = $sth->fetchall_arrayref({});
2564 $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2571 my $invoiceid = AddInvoice(
2572 invoicenumber => $invoicenumber,
2573 booksellerid => $booksellerid,
2574 shipmentdate => $shipmentdate,
2575 billingdate => $billingdate,
2576 closedate => $closedate,
2577 shipmentcost => $shipmentcost,
2578 shipmentcost_budgetid => $shipmentcost_budgetid
2581 Create a new invoice and return its id or undef if it fails.
2588 return unless(%invoice and $invoice{invoicenumber});
2590 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2591 closedate shipmentcost shipmentcost_budgetid message_id);
2595 foreach my $key (keys %invoice) {
2596 if(0 < grep { $_ eq $key } @columns) {
2597 push @set_strs, "$key = ?";
2598 push @set_args, ($invoice{$key} || undef);
2604 my $dbh = C4::Context->dbh;
2605 my $query = "INSERT INTO aqinvoices SET ";
2606 $query .= join (",", @set_strs);
2607 my $sth = $dbh->prepare($query);
2608 $rv = $sth->execute(@set_args);
2610 $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2619 invoiceid => $invoiceid, # Mandatory
2620 invoicenumber => $invoicenumber,
2621 booksellerid => $booksellerid,
2622 shipmentdate => $shipmentdate,
2623 billingdate => $billingdate,
2624 closedate => $closedate,
2625 shipmentcost => $shipmentcost,
2626 shipmentcost_budgetid => $shipmentcost_budgetid
2629 Modify an invoice, invoiceid is mandatory.
2631 Return undef if it fails.
2638 return unless(%invoice and $invoice{invoiceid});
2640 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2641 closedate shipmentcost shipmentcost_budgetid);
2645 foreach my $key (keys %invoice) {
2646 if(0 < grep { $_ eq $key } @columns) {
2647 push @set_strs, "$key = ?";
2648 push @set_args, ($invoice{$key} || undef);
2652 my $dbh = C4::Context->dbh;
2653 my $query = "UPDATE aqinvoices SET ";
2654 $query .= join(",", @set_strs);
2655 $query .= " WHERE invoiceid = ?";
2657 my $sth = $dbh->prepare($query);
2658 $sth->execute(@set_args, $invoice{invoiceid});
2663 CloseInvoice($invoiceid);
2667 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2672 my ($invoiceid) = @_;
2674 return unless $invoiceid;
2676 my $dbh = C4::Context->dbh;
2679 SET closedate = CAST(NOW() AS DATE)
2682 my $sth = $dbh->prepare($query);
2683 $sth->execute($invoiceid);
2686 =head3 ReopenInvoice
2688 ReopenInvoice($invoiceid);
2692 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2697 my ($invoiceid) = @_;
2699 return unless $invoiceid;
2701 my $dbh = C4::Context->dbh;
2704 SET closedate = NULL
2707 my $sth = $dbh->prepare($query);
2708 $sth->execute($invoiceid);
2713 DelInvoice($invoiceid);
2715 Delete an invoice if there are no items attached to it.
2720 my ($invoiceid) = @_;
2722 return unless $invoiceid;
2724 my $dbh = C4::Context->dbh;
2730 my $sth = $dbh->prepare($query);
2731 $sth->execute($invoiceid);
2732 my $res = $sth->fetchrow_arrayref;
2733 if ( $res && $res->[0] == 0 ) {
2735 DELETE FROM aqinvoices
2738 my $sth = $dbh->prepare($query);
2739 return ( $sth->execute($invoiceid) > 0 );
2744 =head3 MergeInvoices
2746 MergeInvoices($invoiceid, \@sourceids);
2748 Merge the invoices identified by the IDs in \@sourceids into
2749 the invoice identified by $invoiceid.
2754 my ($invoiceid, $sourceids) = @_;
2756 return unless $invoiceid;
2757 foreach my $sourceid (@$sourceids) {
2758 next if $sourceid == $invoiceid;
2759 my $source = GetInvoiceDetails($sourceid);
2760 foreach my $order (@{$source->{'orders'}}) {
2761 $order->{'invoiceid'} = $invoiceid;
2764 DelInvoice($source->{'invoiceid'});
2769 =head3 GetBiblioCountByBasketno
2771 $biblio_count = &GetBiblioCountByBasketno($basketno);
2773 Looks up the biblio's count that has basketno value $basketno
2779 sub GetBiblioCountByBasketno {
2780 my ($basketno) = @_;
2781 my $dbh = C4::Context->dbh;
2783 SELECT COUNT( DISTINCT( biblionumber ) )
2786 AND datecancellationprinted IS NULL
2789 my $sth = $dbh->prepare($query);
2790 $sth->execute($basketno);
2791 return $sth->fetchrow;
2794 =head3 populate_order_with_prices
2796 $order = populate_order_with_prices({
2797 order => $order #a hashref with the order values
2798 booksellerid => $booksellerid #FIXME - should obtain from order basket
2799 receiving => 1 # boolean representing order stage, should pass only this or ordering
2800 ordering => 1 # boolean representing order stage
2804 Sets calculated values for an order - all values are stored with full precision
2805 regardless of rounding preference except for tax value which is calculated
2806 on rounded values if requested
2808 For ordering the values set are:
2813 tax_value_on_ordering
2814 For receiving the value set are:
2815 unitprice_tax_included
2816 unitprice_tax_excluded
2817 tax_value_on_receiving
2819 Note: When receiving, if the rounded value of the unitprice matches the rounded
2820 value of the ecost then then ecost (full precision) is used.
2822 Returns a hashref of the order
2824 FIXME: Move this to Koha::Acquisition::Order.pm
2828 sub populate_order_with_prices {
2831 my $order = $params->{order};
2832 my $booksellerid = $params->{booksellerid};
2833 return unless $booksellerid;
2835 my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
2837 my $receiving = $params->{receiving};
2838 my $ordering = $params->{ordering};
2839 my $discount = $order->{discount};
2840 $discount /= 100 if $discount > 1;
2843 $order->{tax_rate_on_ordering} //= $order->{tax_rate};
2844 if ( $bookseller->listincgst ) {
2846 # The user entered the prices tax included
2847 $order->{unitprice} += 0;
2848 $order->{unitprice_tax_included} = $order->{unitprice};
2849 $order->{rrp_tax_included} = $order->{rrp};
2851 # price tax excluded = price tax included / ( 1 + tax rate )
2852 $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2853 $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2855 # ecost tax included = rrp tax included ( 1 - discount )
2856 $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
2858 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2859 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2861 # tax value = quantity * ecost tax excluded * tax rate
2862 # we should use the unitprice if included
2863 my $cost_tax_included = $order->{unitprice_tax_included} == 0 ? $order->{ecost_tax_included} : $order->{unitprice_tax_included};
2864 my $cost_tax_excluded = $order->{unitprice_tax_excluded} == 0 ? $order->{ecost_tax_excluded} : $order->{unitprice_tax_excluded};
2865 $order->{tax_value_on_ordering} = ( get_rounded_price($cost_tax_included) - get_rounded_price($cost_tax_excluded) ) * $order->{quantity};
2869 # The user entered the prices tax excluded
2870 $order->{unitprice_tax_excluded} = $order->{unitprice};
2871 $order->{rrp_tax_excluded} = $order->{rrp};
2873 # price tax included = price tax excluded * ( 1 - tax rate )
2874 $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2875 $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2877 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2878 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2880 # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount ) = ecost tax excluded * ( 1 + tax rate )
2881 $order->{ecost_tax_included} = $order->{ecost_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2883 # tax value = quantity * ecost tax included * tax rate
2884 # we should use the unitprice if included
2885 my $cost_tax_excluded = $order->{unitprice_tax_excluded} == 0 ? $order->{ecost_tax_excluded} : $order->{unitprice_tax_excluded};
2886 $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($cost_tax_excluded) * $order->{tax_rate_on_ordering};
2891 $order->{tax_rate_on_receiving} //= $order->{tax_rate};
2892 if ( $bookseller->invoiceincgst ) {
2893 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2894 # we need to keep the exact ecost value
2895 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
2896 $order->{unitprice} = $order->{ecost_tax_included};
2899 # The user entered the unit price tax included
2900 $order->{unitprice_tax_included} = $order->{unitprice};
2902 # unit price tax excluded = unit price tax included / ( 1 + tax rate )
2903 $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
2906 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2907 # we need to keep the exact ecost value
2908 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
2909 $order->{unitprice} = $order->{ecost_tax_excluded};
2912 # The user entered the unit price tax excluded
2913 $order->{unitprice_tax_excluded} = $order->{unitprice};
2916 # unit price tax included = unit price tax included * ( 1 + tax rate )
2917 $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
2920 # tax value = quantity * unit price tax excluded * tax rate
2921 $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
2927 =head3 GetOrderUsers
2929 $order_users_ids = &GetOrderUsers($ordernumber);
2931 Returns a list of all borrowernumbers that are in order users list
2936 my ($ordernumber) = @_;
2938 return unless $ordernumber;
2941 SELECT borrowernumber
2943 WHERE ordernumber = ?
2945 my $dbh = C4::Context->dbh;
2946 my $sth = $dbh->prepare($query);
2947 $sth->execute($ordernumber);
2948 my $results = $sth->fetchall_arrayref( {} );
2950 my @borrowernumbers;
2951 foreach (@$results) {
2952 push @borrowernumbers, $_->{'borrowernumber'};
2955 return @borrowernumbers;
2958 =head3 ModOrderUsers
2960 my @order_users_ids = (1, 2, 3);
2961 &ModOrderUsers($ordernumber, @basketusers_ids);
2963 Delete all users from order users list, and add users in C<@order_users_ids>
2969 my ( $ordernumber, @order_users_ids ) = @_;
2971 return unless $ordernumber;
2973 my $dbh = C4::Context->dbh;
2975 DELETE FROM aqorder_users
2976 WHERE ordernumber = ?
2978 my $sth = $dbh->prepare($query);
2979 $sth->execute($ordernumber);
2982 INSERT INTO aqorder_users (ordernumber, borrowernumber)
2985 $sth = $dbh->prepare($query);
2986 foreach my $order_user_id (@order_users_ids) {
2987 $sth->execute( $ordernumber, $order_user_id );
2991 sub NotifyOrderUsers {
2992 my ($ordernumber) = @_;
2994 my @borrowernumbers = GetOrderUsers($ordernumber);
2995 return unless @borrowernumbers;
2997 my $order = GetOrder( $ordernumber );
2998 for my $borrowernumber (@borrowernumbers) {
2999 my $patron = Koha::Patrons->find( $borrowernumber );
3000 my $library = $patron->library->unblessed;
3001 my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed;
3002 my $letter = C4::Letters::GetPreparedLetter(
3003 module => 'acquisition',
3004 letter_code => 'ACQ_NOTIF_ON_RECEIV',
3005 branchcode => $library->{branchcode},
3006 lang => $patron->lang,
3008 'branches' => $library,
3009 'borrowers' => $patron->unblessed,
3010 'biblio' => $biblio,
3011 'aqorders' => $order,
3015 C4::Letters::EnqueueLetter(
3018 borrowernumber => $borrowernumber,
3019 LibraryName => C4::Context->preference("LibraryName"),
3020 message_transport_type => 'email',
3022 ) or warn "can't enqueue letter $letter";
3027 =head3 FillWithDefaultValues
3029 FillWithDefaultValues( $marc_record, $params );
3031 This will update the record with default value defined in the ACQ framework.
3032 For all existing fields, if a default value exists and there are no subfield, it will be created.
3033 If the field does not exist, it will be created too.
3035 If the parameter only_mandatory => 1 is passed via $params, only the mandatory
3036 defaults are being applied to the record.
3040 sub FillWithDefaultValues {
3041 my ( $record, $params ) = @_;
3042 my $mandatory = $params->{only_mandatory};
3043 my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3046 C4::Biblio::GetMarcFromKohaField( 'items.itemnumber' );
3047 for my $tag ( sort keys %$tagslib ) {
3049 next if $tag == $itemfield;
3050 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3051 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3052 next if $mandatory && !$tagslib->{$tag}{$subfield}{mandatory};
3053 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3054 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3055 my @fields = $record->field($tag);
3057 for my $field (@fields) {
3058 if ( $field->is_control_field ) {
3059 $field->update($defaultvalue) if not defined $field->data;
3061 elsif ( not defined $field->subfield($subfield) ) {
3062 $field->add_subfields(
3063 $subfield => $defaultvalue );
3068 if ( $tag < 10 ) { # is_control_field
3069 $record->insert_fields_ordered(
3076 $record->insert_fields_ordered(
3078 $tag, '', '', $subfield => $defaultvalue
3094 Koha Development Team <http://koha-community.org/>