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 $csv = Text::CSV_XS->new({'quote_char'=>'"','escape_char'=>'"','sep_char'=>$csv_profile->csv_separator,'binary'=>1});
280 my $csv_profile_content = $csv_profile->content;
281 my ( @headers, @fields );
282 while ( $csv_profile_content =~ /
285 ([^\|]*) # fieldname (table.row or row)
289 my $field = ($2 eq '') ? $1 : $2;
291 $header =~ s/^\s+|\s+$//g; # Trim whitespaces
292 push @headers, $header;
294 $field =~ s/[^\.]*\.{1}//; # Remove the table name if exists.
295 $field =~ s/^\s+|\s+$//g; # Trim whitespaces
296 push @fields, $field;
298 for my $order (@orders) {
300 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
301 my $biblioitem = $biblio->biblioitem;
302 $order = { %$order, %{ $biblioitem->unblessed } };
304 $order = {%$order, %$contract};
306 $order = {%$order, %$basket, %{ $biblio->unblessed }};
307 for my $field (@fields) {
308 push @row, $order->{$field};
312 my $content = join( $csv_profile->csv_separator, @headers ) . "\n";
313 for my $row ( @rows ) {
314 $csv->combine(@$row);
315 my $string = $csv->string;
316 $content .= $string . "\n";
321 foreach my $order (@orders) {
322 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
323 my $biblioitem = $biblio->biblioitem;
325 contractname => $contract->{'contractname'},
326 ordernumber => $order->{'ordernumber'},
327 entrydate => $order->{'entrydate'},
328 isbn => $order->{'isbn'},
329 author => $biblio->author,
330 title => $biblio->title,
331 publicationyear => $biblioitem->publicationyear,
332 publishercode => $biblioitem->publishercode,
333 collectiontitle => $biblioitem->collectiontitle,
334 notes => $order->{'order_vendornote'},
335 quantity => $order->{'quantity'},
336 rrp => $order->{'rrp'},
338 for my $place ( qw( deliveryplace billingplace ) ) {
339 if ( my $library = Koha::Libraries->find( $row->{deliveryplace} ) ) {
340 $row->{$place} = $library->branchname
344 contractname author title publishercode collectiontitle notes
345 deliveryplace billingplace
347 # Double the quotes to not be interpreted as a field end
348 $row->{$_} =~ s/"/""/g if $row->{$_};
354 if(defined $a->{publishercode} and defined $b->{publishercode}) {
355 $a->{publishercode} cmp $b->{publishercode};
359 $template->param(rows => \@rows);
361 return $template->output;
366 =head3 GetBasketGroupAsCSV
368 &GetBasketGroupAsCSV($basketgroupid);
370 Export a basket group as CSV
372 $cgi parameter is needed for column name translation
376 sub GetBasketGroupAsCSV {
377 my ($basketgroupid, $cgi) = @_;
378 my $baskets = GetBasketsByBasketgroup($basketgroupid);
380 my $template = C4::Templates::gettemplate('acqui/csv/basketgroup.tt', 'intranet', $cgi);
383 for my $basket (@$baskets) {
384 my @orders = GetOrders( $basket->{basketno} );
385 my $contract = GetContract({
386 contractnumber => $basket->{contractnumber}
388 my $bookseller = Koha::Acquisition::Booksellers->find( $basket->{booksellerid} );
389 my $basketgroup = GetBasketgroup( $$basket{basketgroupid} );
391 foreach my $order (@orders) {
392 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
393 my $biblioitem = $biblio->biblioitem;
395 clientnumber => $bookseller->accountnumber,
396 basketname => $basket->{basketname},
397 ordernumber => $order->{ordernumber},
398 author => $biblio->author,
399 title => $biblio->title,
400 publishercode => $biblioitem->publishercode,
401 publicationyear => $biblioitem->publicationyear,
402 collectiontitle => $biblioitem->collectiontitle,
403 isbn => $order->{isbn},
404 quantity => $order->{quantity},
405 rrp_tax_included => $order->{rrp_tax_included},
406 rrp_tax_excluded => $order->{rrp_tax_excluded},
407 discount => $bookseller->discount,
408 ecost_tax_included => $order->{ecost_tax_included},
409 ecost_tax_excluded => $order->{ecost_tax_excluded},
410 notes => $order->{order_vendornote},
411 entrydate => $order->{entrydate},
412 booksellername => $bookseller->name,
413 bookselleraddress => $bookseller->address1,
414 booksellerpostal => $bookseller->postal,
415 contractnumber => $contract->{contractnumber},
416 contractname => $contract->{contractname},
419 basketgroupdeliveryplace => $basketgroup->{deliveryplace},
420 basketgroupbillingplace => $basketgroup->{billingplace},
421 basketdeliveryplace => $basket->{deliveryplace},
422 basketbillingplace => $basket->{billingplace},
424 for my $place (qw( basketgroupdeliveryplace basketgroupbillingplace basketdeliveryplace basketbillingplace )) {
425 if ( my $library = Koha::Libraries->find( $temp->{$place} ) ) {
426 $row->{$place} = $library->branchname;
430 basketname author title publishercode collectiontitle notes
431 booksellername bookselleraddress booksellerpostal contractname
432 basketgroupdeliveryplace basketgroupbillingplace
433 basketdeliveryplace basketbillingplace
435 # Double the quotes to not be interpreted as a field end
436 $row->{$_} =~ s/"/""/g if $row->{$_};
441 $template->param(rows => \@rows);
443 return $template->output;
447 =head3 CloseBasketgroup
449 &CloseBasketgroup($basketgroupno);
455 sub CloseBasketgroup {
456 my ($basketgroupno) = @_;
457 my $dbh = C4::Context->dbh;
458 my $sth = $dbh->prepare("
459 UPDATE aqbasketgroups
463 $sth->execute($basketgroupno);
466 #------------------------------------------------------------#
468 =head3 ReOpenBaskergroup($basketgroupno)
470 &ReOpenBaskergroup($basketgroupno);
476 sub ReOpenBasketgroup {
477 my ($basketgroupno) = @_;
478 my $dbh = C4::Context->dbh;
479 my $sth = $dbh->prepare("
480 UPDATE aqbasketgroups
484 $sth->execute($basketgroupno);
487 #------------------------------------------------------------#
491 &ModBasket($basketinfo);
493 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
497 =item C<$basketno> is the primary key of the basket in the aqbasket table.
504 my $basketinfo = shift;
505 my $query = "UPDATE aqbasket SET ";
507 foreach my $key (keys %$basketinfo){
508 if ($key ne 'basketno'){
509 $query .= "$key=?, ";
510 push(@params, $basketinfo->{$key} || undef );
513 # get rid of the "," at the end of $query
514 if (substr($query, length($query)-2) eq ', '){
519 $query .= "WHERE basketno=?";
520 push(@params, $basketinfo->{'basketno'});
521 my $dbh = C4::Context->dbh;
522 my $sth = $dbh->prepare($query);
523 $sth->execute(@params);
525 # Log the basket update
526 if (C4::Context->preference("AcquisitionLog")) {
527 my $modified = Koha::Acquisition::Baskets->find(
528 $basketinfo->{basketno}
533 $basketinfo->{basketno},
534 to_json($modified->unblessed)
541 #------------------------------------------------------------#
543 =head3 ModBasketHeader
545 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
547 Modifies a basket's header.
551 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
553 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
555 =item C<$note> is the "note" field in the "aqbasket" table;
557 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
559 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
561 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
563 =item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
565 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
567 =item C<$is_standing> is the "is_standing" field in the aqbasket table.
569 =item C<$create_items> should be set to 'ordering', 'receiving' or 'cataloguing' (or undef, in which
570 case the AcqCreateItem syspref takes precedence).
576 sub ModBasketHeader {
577 my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items) = @_;
582 SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=?, is_standing=?, create_items=?
586 my $dbh = C4::Context->dbh;
587 my $sth = $dbh->prepare($query);
588 $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items || undef, $basketno);
590 if ( $contractnumber ) {
591 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
592 my $sth2 = $dbh->prepare($query2);
593 $sth2->execute($contractnumber,$basketno);
596 # Log the basket update
597 if (C4::Context->preference("AcquisitionLog")) {
598 my $modified = Koha::Acquisition::Baskets->find(
603 'MODIFY_BASKET_HEADER',
605 to_json($modified->unblessed)
612 #------------------------------------------------------------#
614 =head3 GetBasketsByBookseller
616 @results = &GetBasketsByBookseller($booksellerid, $extra);
618 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
622 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
624 =item C<$extra> is the extra sql parameters, can be
626 $extra->{groupby}: group baskets by column
627 ex. $extra->{groupby} = aqbasket.basketgroupid
628 $extra->{orderby}: order baskets by column
629 $extra->{limit}: limit number of results (can be helpful for pagination)
635 sub GetBasketsByBookseller {
636 my ($booksellerid, $extra) = @_;
637 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
639 if ($extra->{groupby}) {
640 $query .= " GROUP by $extra->{groupby}";
642 if ($extra->{orderby}){
643 $query .= " ORDER by $extra->{orderby}";
645 if ($extra->{limit}){
646 $query .= " LIMIT $extra->{limit}";
649 my $dbh = C4::Context->dbh;
650 my $sth = $dbh->prepare($query);
651 $sth->execute($booksellerid);
652 return $sth->fetchall_arrayref({});
655 =head3 GetBasketsInfosByBookseller
657 my $baskets = GetBasketsInfosByBookseller($supplierid, $allbaskets);
659 The optional second parameter allbaskets is a boolean allowing you to
660 select all baskets from the supplier; by default only active baskets (open or
661 closed but still something to receive) are returned.
663 Returns in a arrayref of hashref all about booksellers baskets, plus:
664 total_biblios: Number of distinct biblios in basket
665 total_items: Number of items in basket
666 expected_items: Number of non-received items in basket
670 sub GetBasketsInfosByBookseller {
671 my ($supplierid, $allbaskets) = @_;
673 return unless $supplierid;
675 my $dbh = C4::Context->dbh;
677 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,
678 SUM(aqorders.quantity) AS total_items,
680 IF ( aqorders.orderstatus = 'cancelled', aqorders.quantity, 0 )
681 ) AS total_items_cancelled,
682 COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
684 IF(aqorders.datereceived IS NULL
685 AND aqorders.datecancellationprinted IS NULL
689 SUM( aqorders.uncertainprice ) AS uncertainprices
691 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
692 WHERE booksellerid = ?};
694 $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";
696 unless ( $allbaskets ) {
697 # Don't show the basket if it's NOT CLOSED or is FULLY RECEIVED
698 $query.=" HAVING (closedate IS NULL OR (
700 IF(aqorders.datereceived IS NULL
701 AND aqorders.datecancellationprinted IS NULL
707 my $sth = $dbh->prepare($query);
708 $sth->execute($supplierid);
709 my $baskets = $sth->fetchall_arrayref({});
711 # Retrieve the number of biblios cancelled
712 my $cancelled_biblios = $dbh->selectall_hashref( q|
713 SELECT COUNT(DISTINCT(biblionumber)) AS total_biblios_cancelled, aqbasket.basketno
715 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
716 WHERE booksellerid = ?
717 AND aqorders.orderstatus = 'cancelled'
718 GROUP BY aqbasket.basketno
719 |, 'basketno', {}, $supplierid );
721 $_->{total_biblios_cancelled} = $cancelled_biblios->{$_->{basketno}}{total_biblios_cancelled} || 0
727 =head3 GetBasketUsers
729 $basketusers_ids = &GetBasketUsers($basketno);
731 Returns a list of all borrowernumbers that are in basket users list
736 my $basketno = shift;
738 return unless $basketno;
741 SELECT borrowernumber
745 my $dbh = C4::Context->dbh;
746 my $sth = $dbh->prepare($query);
747 $sth->execute($basketno);
748 my $results = $sth->fetchall_arrayref( {} );
751 foreach (@$results) {
752 push @borrowernumbers, $_->{'borrowernumber'};
755 return @borrowernumbers;
758 =head3 ModBasketUsers
760 my @basketusers_ids = (1, 2, 3);
761 &ModBasketUsers($basketno, @basketusers_ids);
763 Delete all users from basket users list, and add users in C<@basketusers_ids>
769 my ($basketno, @basketusers_ids) = @_;
771 return unless $basketno;
773 my $dbh = C4::Context->dbh;
775 DELETE FROM aqbasketusers
778 my $sth = $dbh->prepare($query);
779 $sth->execute($basketno);
782 INSERT INTO aqbasketusers (basketno, borrowernumber)
785 $sth = $dbh->prepare($query);
786 foreach my $basketuser_id (@basketusers_ids) {
787 $sth->execute($basketno, $basketuser_id);
790 # Log the basket update
791 if (C4::Context->preference("AcquisitionLog")) {
794 'MODIFY_BASKET_USERS',
797 basketno => $basketno,
798 basketusers => @basketusers_ids
806 =head3 CanUserManageBasket
808 my $bool = CanUserManageBasket($borrower, $basket[, $userflags]);
809 my $bool = CanUserManageBasket($borrowernumber, $basketno[, $userflags]);
811 Check if a borrower can manage a basket, according to system preference
812 AcqViewBaskets, user permissions and basket properties (creator, users list,
815 First parameter can be either a borrowernumber or a hashref as returned by
816 Koha::Patron->unblessed
818 Second parameter can be either a basketno or a hashref as returned by
819 C4::Acquisition::GetBasket.
821 The third parameter is optional. If given, it should be a hashref as returned
822 by C4::Auth::getuserflags. If not, getuserflags is called.
824 If user is authorised to manage basket, returns 1.
829 sub CanUserManageBasket {
830 my ($borrower, $basket, $userflags) = @_;
832 if (!ref $borrower) {
833 # FIXME This needs to be replaced
834 # We should not accept both scalar and array
835 # Tests need to be updated
836 $borrower = Koha::Patrons->find( $borrower )->unblessed;
839 $basket = GetBasket($basket);
842 return 0 unless ($basket and $borrower);
844 my $borrowernumber = $borrower->{borrowernumber};
845 my $basketno = $basket->{basketno};
847 my $AcqViewBaskets = C4::Context->preference('AcqViewBaskets');
849 if (!defined $userflags) {
850 my $dbh = C4::Context->dbh;
851 my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE borrowernumber = ?");
852 $sth->execute($borrowernumber);
853 my ($flags) = $sth->fetchrow_array;
856 $userflags = C4::Auth::getuserflags($flags, $borrower->{userid}, $dbh);
859 unless ($userflags->{superlibrarian}
860 || (ref $userflags->{acquisition} && $userflags->{acquisition}->{order_manage_all})
861 || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
863 if (not exists $userflags->{acquisition}) {
867 if ( (ref $userflags->{acquisition} && !$userflags->{acquisition}->{order_manage})
868 || (!ref $userflags->{acquisition} && !$userflags->{acquisition}) ) {
872 if ($AcqViewBaskets eq 'user'
873 && $basket->{authorisedby} != $borrowernumber
874 && ! grep { $borrowernumber eq $_ } GetBasketUsers($basketno)) {
878 if ($AcqViewBaskets eq 'branch' && defined $basket->{branch}
879 && $basket->{branch} ne $borrower->{branchcode}) {
887 #------------------------------------------------------------#
889 =head3 GetBasketsByBasketgroup
891 $baskets = &GetBasketsByBasketgroup($basketgroupid);
893 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
897 sub GetBasketsByBasketgroup {
898 my $basketgroupid = shift;
900 SELECT *, aqbasket.booksellerid as booksellerid
902 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?
904 my $dbh = C4::Context->dbh;
905 my $sth = $dbh->prepare($query);
906 $sth->execute($basketgroupid);
907 return $sth->fetchall_arrayref({});
910 #------------------------------------------------------------#
912 =head3 NewBasketgroup
914 $basketgroupid = NewBasketgroup(\%hashref);
916 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
918 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
920 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
922 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
924 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
926 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
928 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
930 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
932 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
937 my $basketgroupinfo = shift;
938 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
939 my $query = "INSERT INTO aqbasketgroups (";
941 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
942 if ( defined $basketgroupinfo->{$field} ) {
943 $query .= "$field, ";
944 push(@params, $basketgroupinfo->{$field});
947 $query .= "booksellerid) VALUES (";
952 push(@params, $basketgroupinfo->{'booksellerid'});
953 my $dbh = C4::Context->dbh;
954 my $sth = $dbh->prepare($query);
955 $sth->execute(@params);
956 my $basketgroupid = $dbh->{'mysql_insertid'};
957 if( $basketgroupinfo->{'basketlist'} ) {
958 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
959 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
960 my $sth2 = $dbh->prepare($query2);
961 $sth2->execute($basketgroupid, $basketno);
964 return $basketgroupid;
967 #------------------------------------------------------------#
969 =head3 ModBasketgroup
971 ModBasketgroup(\%hashref);
973 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
975 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
977 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
979 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
981 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
983 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
985 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
987 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
989 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
994 my $basketgroupinfo = shift;
995 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
996 my $dbh = C4::Context->dbh;
997 my $query = "UPDATE aqbasketgroups SET ";
999 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
1000 if ( defined $basketgroupinfo->{$field} ) {
1001 $query .= "$field=?, ";
1002 push(@params, $basketgroupinfo->{$field});
1007 $query .= " WHERE id=?";
1008 push(@params, $basketgroupinfo->{'id'});
1009 my $sth = $dbh->prepare($query);
1010 $sth->execute(@params);
1012 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
1013 $sth->execute($basketgroupinfo->{'id'});
1015 if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
1016 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
1017 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
1018 $sth->execute($basketgroupinfo->{'id'}, $basketno);
1024 #------------------------------------------------------------#
1026 =head3 DelBasketgroup
1028 DelBasketgroup($basketgroupid);
1030 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
1034 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
1040 sub DelBasketgroup {
1041 my $basketgroupid = shift;
1042 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1043 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
1044 my $dbh = C4::Context->dbh;
1045 my $sth = $dbh->prepare($query);
1046 $sth->execute($basketgroupid);
1050 #------------------------------------------------------------#
1053 =head2 FUNCTIONS ABOUT ORDERS
1055 =head3 GetBasketgroup
1057 $basketgroup = &GetBasketgroup($basketgroupid);
1059 Returns a reference to the hash containing all information about the basketgroup.
1063 sub GetBasketgroup {
1064 my $basketgroupid = shift;
1065 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1066 my $dbh = C4::Context->dbh;
1067 my $result_set = $dbh->selectall_arrayref(
1068 'SELECT * FROM aqbasketgroups WHERE id=?',
1072 return $result_set->[0]; # id is unique
1075 #------------------------------------------------------------#
1077 =head3 GetBasketgroups
1079 $basketgroups = &GetBasketgroups($booksellerid);
1081 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
1085 sub GetBasketgroups {
1086 my $booksellerid = shift;
1087 die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
1088 my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
1089 my $dbh = C4::Context->dbh;
1090 my $sth = $dbh->prepare($query);
1091 $sth->execute($booksellerid);
1092 return $sth->fetchall_arrayref({});
1095 #------------------------------------------------------------#
1097 =head2 FUNCTIONS ABOUT ORDERS
1101 @orders = &GetOrders( $basketno, { orderby => 'biblio.title', cancelled => 0|1 } );
1103 Looks up the pending (non-cancelled) orders with the given basket
1106 If cancelled is set, only cancelled orders will be returned.
1111 my ( $basketno, $params ) = @_;
1113 return () unless $basketno;
1115 my $orderby = $params->{orderby};
1116 my $cancelled = $params->{cancelled} || 0;
1118 my $dbh = C4::Context->dbh;
1120 SELECT biblio.*,biblioitems.*,
1124 $query .= $cancelled
1126 aqorders_transfers.ordernumber_to AS transferred_to,
1127 aqorders_transfers.timestamp AS transferred_to_timestamp
1130 aqorders_transfers.ordernumber_from AS transferred_from,
1131 aqorders_transfers.timestamp AS transferred_from_timestamp
1135 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1136 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1137 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1139 $query .= $cancelled
1141 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
1144 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1152 $orderby ||= q|biblioitems.publishercode, biblio.title|;
1154 AND datecancellationprinted IS NOT NULL
1159 q|aqorders.datecancellationprinted desc, aqorders.timestamp desc|;
1161 AND datecancellationprinted IS NULL
1165 $query .= " ORDER BY $orderby";
1167 $dbh->selectall_arrayref( $query, { Slice => {} }, $basketno );
1172 #------------------------------------------------------------#
1174 =head3 GetOrdersByBiblionumber
1176 @orders = &GetOrdersByBiblionumber($biblionumber);
1178 Looks up the orders with linked to a specific $biblionumber, including
1179 cancelled orders and received orders.
1182 C<@orders> is an array of references-to-hash, whose keys are the
1183 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
1187 sub GetOrdersByBiblionumber {
1188 my $biblionumber = shift;
1189 return unless $biblionumber;
1190 my $dbh = C4::Context->dbh;
1192 SELECT biblio.*,biblioitems.*,
1196 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1197 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1198 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1199 WHERE aqorders.biblionumber=?
1202 $dbh->selectall_arrayref( $query, { Slice => {} }, $biblionumber );
1203 return @{$result_set};
1207 #------------------------------------------------------------#
1211 $order = &GetOrder($ordernumber);
1213 Looks up an order by order number.
1215 Returns a reference-to-hash describing the order. The keys of
1216 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1221 my ($ordernumber) = @_;
1222 return unless $ordernumber;
1224 my $dbh = C4::Context->dbh;
1225 my $query = qq{SELECT
1229 aqbasket.basketname,
1230 borrowers.branchcode,
1231 biblioitems.publicationyear,
1232 biblio.copyrightdate,
1233 biblioitems.editionstatement,
1237 biblioitems.publishercode,
1238 aqorders.rrp AS unitpricesupplier,
1239 aqorders.ecost AS unitpricelib,
1240 aqbudgets.budget_name AS budget,
1241 aqbooksellers.name AS supplier,
1242 aqbooksellers.id AS supplierid,
1243 biblioitems.publishercode AS publisher,
1244 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1245 DATE(aqbasket.closedate) AS orderdate,
1246 aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity_to_receive,
1247 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1248 DATEDIFF(CURDATE( ),closedate) AS latesince
1249 FROM aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1250 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1251 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1252 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
1253 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1254 WHERE aqorders.basketno = aqbasket.basketno
1257 $dbh->selectall_arrayref( $query, { Slice => {} }, $ordernumber );
1259 # result_set assumed to contain 1 match
1260 return $result_set->[0];
1265 &ModOrder(\%hashref);
1267 Modifies an existing order. Updates the order with order number
1268 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1269 other keys of the hash update the fields with the same name in the aqorders
1270 table of the Koha database.
1275 my $orderinfo = shift;
1277 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '';
1279 my $dbh = C4::Context->dbh;
1282 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1283 $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1285 # delete($orderinfo->{'branchcode'});
1286 # the hash contains a lot of entries not in aqorders, so get the columns ...
1287 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1289 my $colnames = $sth->{NAME};
1290 #FIXME Be careful. If aqorders would have columns with diacritics,
1291 #you should need to decode what you get back from NAME.
1292 #See report 10110 and guided_reports.pl
1293 my $query = "UPDATE aqorders SET ";
1295 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1296 # ... and skip hash entries that are not in the aqorders table
1297 # FIXME : probably not the best way to do it (would be better to have a correct hash)
1298 next unless grep { $_ eq $orderinfokey } @$colnames;
1299 $query .= "$orderinfokey=?, ";
1300 push(@params, $orderinfo->{$orderinfokey});
1303 $query .= "timestamp=NOW() WHERE ordernumber=?";
1304 push(@params, $orderinfo->{'ordernumber'} );
1305 $sth = $dbh->prepare($query);
1306 $sth->execute(@params);
1310 #------------------------------------------------------------#
1314 ModItemOrder($itemnumber, $ordernumber);
1316 Modifies the ordernumber of an item in aqorders_items.
1321 my ($itemnumber, $ordernumber) = @_;
1323 return unless ($itemnumber and $ordernumber);
1325 my $dbh = C4::Context->dbh;
1327 UPDATE aqorders_items
1329 WHERE itemnumber = ?
1331 my $sth = $dbh->prepare($query);
1332 return $sth->execute($ordernumber, $itemnumber);
1335 #------------------------------------------------------------#
1337 =head3 ModReceiveOrder
1339 my ( $date_received, $new_ordernumber ) = ModReceiveOrder(
1341 biblionumber => $biblionumber,
1343 quantityreceived => $quantityreceived,
1345 invoice => $invoice,
1346 budget_id => $budget_id,
1347 datereceived => $datereceived,
1348 received_itemnumbers => \@received_itemnumbers,
1352 Updates an order, to reflect the fact that it was received, at least
1355 If a partial order is received, splits the order into two.
1357 Updates the order with biblionumber C<$biblionumber> and ordernumber
1358 C<$order->{ordernumber}>.
1363 sub ModReceiveOrder {
1365 my $biblionumber = $params->{biblionumber};
1366 my $order = { %{ $params->{order} } }; # Copy the order, we don't want to modify it
1367 my $invoice = $params->{invoice};
1368 my $quantrec = $params->{quantityreceived};
1369 my $user = $params->{user};
1370 my $budget_id = $params->{budget_id};
1371 my $datereceived = $params->{datereceived};
1372 my $received_items = $params->{received_items};
1374 my $dbh = C4::Context->dbh;
1375 $datereceived = output_pref(
1377 dt => ( $datereceived ? dt_from_string( $datereceived ) : dt_from_string ),
1378 dateformat => 'iso',
1383 my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1384 if ($suggestionid) {
1385 ModSuggestion( {suggestionid=>$suggestionid,
1386 STATUS=>'AVAILABLE',
1387 biblionumber=> $biblionumber}
1391 my $result_set = $dbh->selectrow_arrayref(
1392 q{SELECT aqbasket.is_standing
1394 WHERE basketno=?},{ Slice => {} }, $order->{basketno});
1395 my $is_standing = $result_set->[0]; # we assume we have a unique basket
1397 my $new_ordernumber = $order->{ordernumber};
1398 if ( $is_standing || $order->{quantity} > $quantrec ) {
1399 # Split order line in two parts: the first is the original order line
1400 # without received items (the quantity is decreased),
1401 # the second part is a new order line with quantity=quantityrec
1402 # (entirely received)
1406 orderstatus = 'partial'|;
1407 $query .= q| WHERE ordernumber = ?|;
1408 my $sth = $dbh->prepare($query);
1411 ( $is_standing ? 1 : ($order->{quantity} - $quantrec) ),
1412 $order->{ordernumber}
1415 if ( not $order->{subscriptionid} && defined $order->{order_internalnote} ) {
1418 SET order_internalnote = ?
1419 WHERE ordernumber = ?|, {},
1420 $order->{order_internalnote}, $order->{ordernumber}
1424 # Recalculate tax_value
1428 tax_value_on_ordering = quantity * | . get_rounding_sql(q|ecost_tax_excluded|) . q| * tax_rate_on_ordering,
1429 tax_value_on_receiving = quantity * | . get_rounding_sql(q|unitprice_tax_excluded|) . q| * tax_rate_on_receiving
1430 WHERE ordernumber = ?
1431 |, undef, $order->{ordernumber});
1433 delete $order->{ordernumber};
1434 $order->{budget_id} = ( $budget_id || $order->{budget_id} );
1435 $order->{quantity} = $quantrec;
1436 $order->{quantityreceived} = $quantrec;
1437 $order->{ecost_tax_excluded} //= 0;
1438 $order->{tax_rate_on_ordering} //= 0;
1439 $order->{unitprice_tax_excluded} //= 0;
1440 $order->{tax_rate_on_receiving} //= 0;
1441 $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($order->{ecost_tax_excluded}) * $order->{tax_rate_on_ordering};
1442 $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
1443 $order->{datereceived} = $datereceived;
1444 $order->{invoiceid} = $invoice->{invoiceid};
1445 $order->{orderstatus} = 'complete';
1446 $new_ordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber; # TODO What if the store fails?
1448 if ($received_items) {
1449 foreach my $itemnumber (@$received_items) {
1450 ModItemOrder($itemnumber, $new_ordernumber);
1456 SET quantityreceived = ?,
1460 orderstatus = 'complete'
1464 , replacementprice = ?
1465 | if defined $order->{replacementprice};
1468 , unitprice = ?, unitprice_tax_included = ?, unitprice_tax_excluded = ?
1469 | if defined $order->{unitprice};
1472 ,tax_value_on_receiving = ?
1473 | if defined $order->{tax_value_on_receiving};
1476 ,tax_rate_on_receiving = ?
1477 | if defined $order->{tax_rate_on_receiving};
1480 , order_internalnote = ?
1481 | if defined $order->{order_internalnote};
1483 $query .= q| where biblionumber=? and ordernumber=?|;
1485 my $sth = $dbh->prepare( $query );
1486 my @params = ( $quantrec, $datereceived, $invoice->{invoiceid}, ( $budget_id ? $budget_id : $order->{budget_id} ) );
1488 if ( defined $order->{replacementprice} ) {
1489 push @params, $order->{replacementprice};
1492 if ( defined $order->{unitprice} ) {
1493 push @params, $order->{unitprice}, $order->{unitprice_tax_included}, $order->{unitprice_tax_excluded};
1496 if ( defined $order->{tax_value_on_receiving} ) {
1497 push @params, $order->{tax_value_on_receiving};
1500 if ( defined $order->{tax_rate_on_receiving} ) {
1501 push @params, $order->{tax_rate_on_receiving};
1504 if ( defined $order->{order_internalnote} ) {
1505 push @params, $order->{order_internalnote};
1508 push @params, ( $biblionumber, $order->{ordernumber} );
1510 $sth->execute( @params );
1512 # All items have been received, sent a notification to users
1513 NotifyOrderUsers( $order->{ordernumber} );
1516 return ($datereceived, $new_ordernumber);
1519 =head3 CancelReceipt
1521 my $parent_ordernumber = CancelReceipt($ordernumber);
1523 Cancel an order line receipt and update the parent order line, as if no
1525 If items are created at receipt (AcqCreateItem = receiving) then delete
1531 my $ordernumber = shift;
1533 return unless $ordernumber;
1535 my $dbh = C4::Context->dbh;
1537 SELECT datereceived, parent_ordernumber, quantity
1539 WHERE ordernumber = ?
1541 my $sth = $dbh->prepare($query);
1542 $sth->execute($ordernumber);
1543 my $order = $sth->fetchrow_hashref;
1545 warn "CancelReceipt: order $ordernumber does not exist";
1548 unless($order->{'datereceived'}) {
1549 warn "CancelReceipt: order $ordernumber is not received";
1553 my $parent_ordernumber = $order->{'parent_ordernumber'};
1555 my $order_obj = Koha::Acquisition::Orders->find( $ordernumber ); # FIXME rewrite all this subroutine using this object
1556 my @itemnumbers = $order_obj->items->get_column('itemnumber');
1558 if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1559 # The order line has no parent, just mark it as not received
1562 SET quantityreceived = ?,
1565 orderstatus = 'ordered'
1566 WHERE ordernumber = ?
1568 $sth = $dbh->prepare($query);
1569 $sth->execute(0, undef, undef, $ordernumber);
1570 _cancel_items_receipt( $order_obj );
1572 # The order line has a parent, increase parent quantity and delete
1574 unless ( $order_obj->basket->is_standing ) {
1576 SELECT quantity, datereceived
1578 WHERE ordernumber = ?
1580 $sth = $dbh->prepare($query);
1581 $sth->execute($parent_ordernumber);
1582 my $parent_order = $sth->fetchrow_hashref;
1583 unless($parent_order) {
1584 warn "Parent order $parent_ordernumber does not exist.";
1587 if($parent_order->{'datereceived'}) {
1588 warn "CancelReceipt: parent order is received.".
1589 " Can't cancel receipt.";
1595 orderstatus = 'ordered'
1596 WHERE ordernumber = ?
1598 $sth = $dbh->prepare($query);
1599 my $rv = $sth->execute(
1600 $order->{'quantity'} + $parent_order->{'quantity'},
1604 warn "Cannot update parent order line, so do not cancel".
1609 # Recalculate tax_value
1613 tax_value_on_ordering = quantity * | . get_rounding_sql(q|ecost_tax_excluded|) . q| * tax_rate_on_ordering,
1614 tax_value_on_receiving = quantity * | . get_rounding_sql(q|unitprice_tax_excluded|) . q| * tax_rate_on_receiving
1615 WHERE ordernumber = ?
1616 |, undef, $parent_ordernumber);
1619 _cancel_items_receipt( $order_obj, $parent_ordernumber );
1622 DELETE FROM aqorders
1623 WHERE ordernumber = ?
1625 $sth = $dbh->prepare($query);
1626 $sth->execute($ordernumber);
1630 if( $order_obj->basket->effective_create_items eq 'ordering' ) {
1631 my @affects = split q{\|}, C4::Context->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1633 for my $in ( @itemnumbers ) {
1634 my $item = Koha::Items->find( $in ); # FIXME We do not need that, we already have Koha::Items from $order_obj->items
1635 my $biblio = $item->biblio;
1636 my ( $itemfield ) = GetMarcFromKohaField( 'items.itemnumber' );
1637 my $item_marc = C4::Items::GetMarcItem( $biblio->biblionumber, $in );
1638 for my $affect ( @affects ) {
1639 my ( $sf, $v ) = split q{=}, $affect, 2;
1640 foreach ( $item_marc->field($itemfield) ) {
1641 $_->update( $sf => $v );
1644 C4::Items::ModItemFromMarc( $item_marc, $biblio->biblionumber, $in );
1649 return $parent_ordernumber;
1652 sub _cancel_items_receipt {
1653 my ( $order, $parent_ordernumber ) = @_;
1654 $parent_ordernumber ||= $order->ordernumber;
1656 my $items = $order->items;
1657 if ( $order->basket->effective_create_items eq 'receiving' ) {
1658 # Remove items that were created at receipt
1660 DELETE FROM items, aqorders_items
1661 USING items, aqorders_items
1662 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1664 my $dbh = C4::Context->dbh;
1665 my $sth = $dbh->prepare($query);
1666 while ( my $item = $items->next ) {
1667 $sth->execute($item->itemnumber, $item->itemnumber);
1671 while ( my $item = $items->next ) {
1672 ModItemOrder($item->itemnumber, $parent_ordernumber);
1677 #------------------------------------------------------------#
1681 @results = &SearchOrders({
1682 ordernumber => $ordernumber,
1685 booksellerid => $booksellerid,
1686 basketno => $basketno,
1687 basketname => $basketname,
1688 basketgroupname => $basketgroupname,
1692 biblionumber => $biblionumber,
1693 budget_id => $budget_id
1696 Searches for orders filtered by criteria.
1698 C<$ordernumber> Finds matching orders or transferred orders by ordernumber.
1699 C<$search> Finds orders matching %$search% in title, author, or isbn.
1700 C<$owner> Finds order for the logged in user.
1701 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1702 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1705 C<@results> is an array of references-to-hash with the keys are fields
1706 from aqorders, biblio, biblioitems and aqbasket tables.
1711 my ( $params ) = @_;
1712 my $ordernumber = $params->{ordernumber};
1713 my $search = $params->{search};
1714 my $ean = $params->{ean};
1715 my $booksellerid = $params->{booksellerid};
1716 my $basketno = $params->{basketno};
1717 my $basketname = $params->{basketname};
1718 my $basketgroupname = $params->{basketgroupname};
1719 my $owner = $params->{owner};
1720 my $pending = $params->{pending};
1721 my $ordered = $params->{ordered};
1722 my $biblionumber = $params->{biblionumber};
1723 my $budget_id = $params->{budget_id};
1725 my $dbh = C4::Context->dbh;
1728 SELECT aqbasket.basketno,
1730 borrowers.firstname,
1733 biblioitems.biblioitemnumber,
1734 biblioitems.publishercode,
1735 biblioitems.publicationyear,
1736 aqbasket.authorisedby,
1737 aqbasket.booksellerid,
1739 aqbasket.creationdate,
1740 aqbasket.basketname,
1741 aqbasketgroups.id as basketgroupid,
1742 aqbasketgroups.name as basketgroupname,
1745 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1746 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1747 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1748 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1749 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1752 # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
1754 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1758 WHERE (datecancellationprinted is NULL)
1761 if ( $pending or $ordered ) {
1764 ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) )
1766 ( quantity > quantityreceived OR quantityreceived is NULL )
1770 $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1778 my $userenv = C4::Context->userenv;
1779 if ( C4::Context->preference("IndependentBranches") ) {
1780 unless ( C4::Context->IsSuperLibrarian() ) {
1783 borrowers.branchcode = ?
1784 OR borrowers.branchcode = ''
1787 push @args, $userenv->{branch};
1791 if ( $ordernumber ) {
1792 $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1793 push @args, ( $ordernumber, $ordernumber );
1795 if ( $biblionumber ) {
1796 $query .= 'AND aqorders.biblionumber = ?';
1797 push @args, $biblionumber;
1800 $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1801 push @args, ("%$search%","%$search%","%$search%");
1804 $query .= ' AND biblioitems.ean = ?';
1807 if ( $booksellerid ) {
1808 $query .= 'AND aqbasket.booksellerid = ?';
1809 push @args, $booksellerid;
1812 $query .= 'AND aqbasket.basketno = ?';
1813 push @args, $basketno;
1816 $query .= 'AND aqbasket.basketname LIKE ?';
1817 push @args, "%$basketname%";
1819 if( $basketgroupname ) {
1820 $query .= ' AND aqbasketgroups.name LIKE ?';
1821 push @args, "%$basketgroupname%";
1825 $query .= ' AND aqbasket.authorisedby=? ';
1826 push @args, $userenv->{'number'};
1830 $query .= ' AND aqorders.budget_id = ?';
1831 push @args, $budget_id;
1834 $query .= ' ORDER BY aqbasket.basketno';
1836 my $sth = $dbh->prepare($query);
1837 $sth->execute(@args);
1838 return $sth->fetchall_arrayref({});
1841 #------------------------------------------------------------#
1843 =head3 TransferOrder
1845 my $newordernumber = TransferOrder($ordernumber, $basketno);
1847 Transfer an order line to a basket.
1848 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1849 to BOOKSELLER on DATE' and create new order with internal note
1850 'Transferred from BOOKSELLER on DATE'.
1851 Move all attached items to the new order.
1852 Received orders cannot be transferred.
1853 Return the ordernumber of created order.
1858 my ($ordernumber, $basketno) = @_;
1860 return unless ($ordernumber and $basketno);
1862 my $order = Koha::Acquisition::Orders->find( $ordernumber ) or return;
1863 return if $order->datereceived;
1865 $order = $order->unblessed;
1867 my $basket = GetBasket($basketno);
1868 return unless $basket;
1870 my $dbh = C4::Context->dbh;
1871 my ($query, $sth, $rv);
1875 SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1876 WHERE ordernumber = ?
1878 $sth = $dbh->prepare($query);
1879 $rv = $sth->execute('cancelled', $ordernumber);
1881 delete $order->{'ordernumber'};
1882 delete $order->{parent_ordernumber};
1883 $order->{'basketno'} = $basketno;
1885 my $newordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber;
1888 UPDATE aqorders_items
1890 WHERE ordernumber = ?
1892 $sth = $dbh->prepare($query);
1893 $sth->execute($newordernumber, $ordernumber);
1896 INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1899 $sth = $dbh->prepare($query);
1900 $sth->execute($ordernumber, $newordernumber);
1902 return $newordernumber;
1905 =head3 get_rounding_sql
1907 $rounding_sql = get_rounding_sql($column_name);
1909 returns the correct SQL routine based on OrderPriceRounding system preference.
1913 sub get_rounding_sql {
1914 my ( $round_string ) = @_;
1915 my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
1916 if ( $rounding_pref eq "nearest_cent" ) {
1917 return "CAST($round_string*100 AS SIGNED)/100";
1919 return $round_string;
1922 =head3 get_rounded_price
1924 $rounded_price = get_rounded_price( $price );
1926 returns a price rounded as specified in OrderPriceRounding system preference.
1930 sub get_rounded_price {
1932 my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
1933 if( $rounding_pref eq 'nearest_cent' ) {
1934 return Koha::Number::Price->new( $price )->round();
1940 =head2 FUNCTIONS ABOUT PARCELS
1944 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1946 get a lists of parcels.
1953 is the bookseller this function has to get parcels.
1956 To know on what criteria the results list has to be ordered.
1959 is the booksellerinvoicenumber.
1961 =item $datefrom & $dateto
1962 to know on what date this function has to filter its search.
1967 a pointer on a hash list containing parcel informations as such :
1973 =item Last operation
1975 =item Number of biblio
1977 =item Number of items
1984 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1985 my $dbh = C4::Context->dbh;
1986 my @query_params = ();
1988 SELECT aqinvoices.invoicenumber,
1989 datereceived,purchaseordernumber,
1990 count(DISTINCT biblionumber) AS biblio,
1991 sum(quantity) AS itemsexpected,
1992 sum(quantityreceived) AS itemsreceived
1993 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1994 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1995 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1997 push @query_params, $bookseller;
1999 if ( defined $code ) {
2000 $strsth .= ' and aqinvoices.invoicenumber like ? ';
2001 # add a % to the end of the code to allow stemming.
2002 push @query_params, "$code%";
2005 if ( defined $datefrom ) {
2006 $strsth .= ' and datereceived >= ? ';
2007 push @query_params, $datefrom;
2010 if ( defined $dateto ) {
2011 $strsth .= 'and datereceived <= ? ';
2012 push @query_params, $dateto;
2015 $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
2017 # can't use a placeholder to place this column name.
2018 # but, we could probably be checking to make sure it is a column that will be fetched.
2019 $strsth .= "order by $order " if ($order);
2021 my $sth = $dbh->prepare($strsth);
2023 $sth->execute( @query_params );
2024 my $results = $sth->fetchall_arrayref({});
2028 #------------------------------------------------------------#
2032 \@order_loop = GetHistory( %params );
2034 Retreives some acquisition history information
2044 basket - search both basket name and number
2045 booksellerinvoicenumber
2048 orderstatus (note that orderstatus '' will retrieve orders
2049 of any status except cancelled)
2053 get_canceled_order (if set to a true value, cancelled orders will
2057 $order_loop is a list of hashrefs that each look like this:
2059 'author' => 'Twain, Mark',
2061 'biblionumber' => '215',
2063 'creationdate' => 'MM/DD/YYYY',
2064 'datereceived' => undef,
2067 'invoicenumber' => undef,
2069 'ordernumber' => '1',
2071 'quantityreceived' => undef,
2072 'title' => 'The Adventures of Huckleberry Finn',
2073 'managing_library' => 'CPL'
2074 'is_standing' => '1'
2080 # don't run the query if there are no parameters (list would be too long for sure !)
2081 croak "No search params" unless @_;
2083 my $title = $params{title};
2084 my $author = $params{author};
2085 my $isbn = $params{isbn};
2086 my $ean = $params{ean};
2087 my $name = $params{name};
2088 my $from_placed_on = $params{from_placed_on};
2089 my $to_placed_on = $params{to_placed_on};
2090 my $basket = $params{basket};
2091 my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2092 my $basketgroupname = $params{basketgroupname};
2093 my $budget = $params{budget};
2094 my $orderstatus = $params{orderstatus};
2095 my $is_standing = $params{is_standing};
2096 my $biblionumber = $params{biblionumber};
2097 my $get_canceled_order = $params{get_canceled_order} || 0;
2098 my $ordernumber = $params{ordernumber};
2099 my $search_children_too = $params{search_children_too} || 0;
2100 my $created_by = $params{created_by} || [];
2101 my $managing_library = $params{managing_library};
2102 my $ordernumbers = $params{ordernumbers} || [];
2103 my $additional_fields = $params{additional_fields} // [];
2106 my $total_qtyreceived = 0;
2107 my $total_price = 0;
2109 #get variation of isbn
2113 if ( C4::Context->preference("SearchWithISBNVariations") ){
2114 @isbns = C4::Koha::GetVariationsOfISBN( $isbn );
2115 foreach my $isb (@isbns){
2116 push @isbn_params, '?';
2121 push @isbn_params, '?';
2125 my $dbh = C4::Context->dbh;
2128 COALESCE(biblio.title, deletedbiblio.title) AS title,
2129 COALESCE(biblio.author, deletedbiblio.author) AS author,
2130 COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2131 COALESCE(biblioitems.ean, deletedbiblioitems.ean) AS ean,
2133 aqbasket.basketname,
2134 aqbasket.basketgroupid,
2135 aqbasket.authorisedby,
2136 aqbasket.is_standing,
2137 concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2138 branch as managing_library,
2139 aqbasketgroups.name as groupname,
2141 aqbasket.creationdate,
2142 aqorders.datereceived,
2144 aqorders.quantityreceived,
2146 aqorders.ordernumber,
2148 aqinvoices.invoicenumber,
2149 aqbooksellers.id as id,
2150 aqorders.biblionumber,
2151 aqorders.orderstatus,
2152 aqorders.parent_ordernumber,
2153 aqbudgets.budget_name
2155 $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2158 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2159 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2160 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2161 LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2162 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2163 LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2164 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2165 LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2166 LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2167 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2170 $query .= " WHERE 1 ";
2172 unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2173 $query .= " AND datecancellationprinted IS NULL ";
2176 my @query_params = ();
2178 if ( $biblionumber ) {
2179 $query .= " AND biblio.biblionumber = ?";
2180 push @query_params, $biblionumber;
2184 $query .= " AND biblio.title LIKE ? ";
2185 $title =~ s/\s+/%/g;
2186 push @query_params, "%$title%";
2190 $query .= " AND biblio.author LIKE ? ";
2191 push @query_params, "%$author%";
2195 $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2196 foreach my $isb (@isbns){
2197 push @query_params, "%$isb%";
2202 $query .= " AND biblioitems.ean = ? ";
2203 push @query_params, "$ean";
2206 $query .= " AND aqbooksellers.name LIKE ? ";
2207 push @query_params, "%$name%";
2211 $query .= " AND aqbudgets.budget_id = ? ";
2212 push @query_params, "$budget";
2215 if ( $from_placed_on ) {
2216 $query .= " AND creationdate >= ? ";
2217 push @query_params, $from_placed_on;
2220 if ( $to_placed_on ) {
2221 $query .= " AND creationdate <= ? ";
2222 push @query_params, $to_placed_on;
2225 if ( defined $orderstatus and $orderstatus ne '') {
2226 $query .= " AND aqorders.orderstatus = ? ";
2227 push @query_params, "$orderstatus";
2230 if ( $is_standing ) {
2231 $query .= " AND is_standing = ? ";
2232 push @query_params, $is_standing;
2236 if ($basket =~ m/^\d+$/) {
2237 $query .= " AND aqorders.basketno = ? ";
2238 push @query_params, $basket;
2240 $query .= " AND aqbasket.basketname LIKE ? ";
2241 push @query_params, "%$basket%";
2245 if ($booksellerinvoicenumber) {
2246 $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2247 push @query_params, "%$booksellerinvoicenumber%";
2250 if ($basketgroupname) {
2251 $query .= " AND aqbasketgroups.name LIKE ? ";
2252 push @query_params, "%$basketgroupname%";
2256 $query .= " AND (aqorders.ordernumber = ? ";
2257 push @query_params, $ordernumber;
2258 if ($search_children_too) {
2259 $query .= " OR aqorders.parent_ordernumber = ? ";
2260 push @query_params, $ordernumber;
2265 if ( @$created_by ) {
2266 $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2267 push @query_params, @$created_by;
2270 if ( $managing_library ) {
2271 $query .= " AND aqbasket.branch = ? ";
2272 push @query_params, $managing_library;
2275 if ( @$ordernumbers ) {
2276 $query .= ' AND (aqorders.ordernumber IN ( ' . join (',', ('?') x @$ordernumbers ) . '))';
2277 push @query_params, @$ordernumbers;
2279 if ( @$additional_fields ) {
2280 my @baskets = Koha::Acquisition::Baskets->filter_by_additional_fields($additional_fields);
2282 return [] unless @baskets;
2284 # No parameterization because record IDs come directly from DB
2285 $query .= ' AND aqbasket.basketno IN ( ' . join( ',', map { $_->basketno } @baskets ) . ' )';
2288 if ( C4::Context->preference("IndependentBranches") ) {
2289 unless ( C4::Context->IsSuperLibrarian() ) {
2290 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2291 push @query_params, C4::Context->userenv->{branch};
2294 $query .= " ORDER BY id";
2296 return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2299 =head2 GetRecentAcqui
2301 $results = GetRecentAcqui($days);
2303 C<$results> is a ref to a table which contains hashref
2307 sub GetRecentAcqui {
2309 my $dbh = C4::Context->dbh;
2313 ORDER BY timestamp DESC
2316 my $sth = $dbh->prepare($query);
2318 my $results = $sth->fetchall_arrayref({});
2322 #------------------------------------------------------------#
2326 &AddClaim($ordernumber);
2328 Add a claim for an order
2333 my ($ordernumber) = @_;
2334 my $dbh = C4::Context->dbh;
2337 claims_count = claims_count + 1,
2338 claimed_date = CURDATE()
2339 WHERE ordernumber = ?
2341 my $sth = $dbh->prepare($query);
2342 $sth->execute($ordernumber);
2347 my @invoices = GetInvoices(
2348 invoicenumber => $invoicenumber,
2349 supplierid => $supplierid,
2350 suppliername => $suppliername,
2351 shipmentdatefrom => $shipmentdatefrom, # ISO format
2352 shipmentdateto => $shipmentdateto, # ISO format
2353 billingdatefrom => $billingdatefrom, # ISO format
2354 billingdateto => $billingdateto, # ISO format
2355 isbneanissn => $isbn_or_ean_or_issn,
2358 publisher => $publisher,
2359 publicationyear => $publicationyear,
2360 branchcode => $branchcode,
2361 order_by => $order_by
2364 Return a list of invoices that match all given criteria.
2366 $order_by is "column_name (asc|desc)", where column_name is any of
2367 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2368 'shipmentcost', 'shipmentcost_budgetid'.
2370 asc is the default if omitted
2377 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2378 closedate shipmentcost shipmentcost_budgetid);
2380 my $dbh = C4::Context->dbh;
2382 SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
2383 aqbooksellers.name AS suppliername,
2386 aqorders.datereceived IS NOT NULL,
2387 aqorders.biblionumber,
2390 ) AS receivedbiblios,
2393 aqorders.subscriptionid IS NOT NULL,
2394 aqorders.subscriptionid,
2397 ) AS is_linked_to_subscriptions,
2398 SUM(aqorders.quantityreceived) AS receiveditems
2400 LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2401 LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2402 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2403 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2404 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2405 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2406 LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2411 if($args{supplierid}) {
2412 push @bind_strs, " aqinvoices.booksellerid = ? ";
2413 push @bind_args, $args{supplierid};
2415 if($args{invoicenumber}) {
2416 push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2417 push @bind_args, "%$args{invoicenumber}%";
2419 if($args{suppliername}) {
2420 push @bind_strs, " aqbooksellers.name LIKE ? ";
2421 push @bind_args, "%$args{suppliername}%";
2423 if($args{shipmentdatefrom}) {
2424 push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2425 push @bind_args, $args{shipmentdatefrom};
2427 if($args{shipmentdateto}) {
2428 push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2429 push @bind_args, $args{shipmentdateto};
2431 if($args{billingdatefrom}) {
2432 push @bind_strs, " aqinvoices.billingdate >= ? ";
2433 push @bind_args, $args{billingdatefrom};
2435 if($args{billingdateto}) {
2436 push @bind_strs, " aqinvoices.billingdate <= ? ";
2437 push @bind_args, $args{billingdateto};
2439 if($args{isbneanissn}) {
2440 push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2441 push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2444 push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2445 push @bind_args, $args{title};
2448 push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2449 push @bind_args, $args{author};
2451 if($args{publisher}) {
2452 push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2453 push @bind_args, $args{publisher};
2455 if($args{publicationyear}) {
2456 push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2457 push @bind_args, $args{publicationyear}, $args{publicationyear};
2459 if($args{branchcode}) {
2460 push @bind_strs, " borrowers.branchcode = ? ";
2461 push @bind_args, $args{branchcode};
2463 if($args{message_id}) {
2464 push @bind_strs, " aqinvoices.message_id = ? ";
2465 push @bind_args, $args{message_id};
2468 $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2469 $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";
2471 if($args{order_by}) {
2472 my ($column, $direction) = split / /, $args{order_by};
2473 if(grep { $_ eq $column } @columns) {
2474 $direction ||= 'ASC';
2475 $query .= " ORDER BY $column $direction";
2479 my $sth = $dbh->prepare($query);
2480 $sth->execute(@bind_args);
2482 my $results = $sth->fetchall_arrayref({});
2488 my $invoice = GetInvoice($invoiceid);
2490 Get informations about invoice with given $invoiceid
2492 Return a hash filled with aqinvoices.* fields
2497 my ($invoiceid) = @_;
2500 return unless $invoiceid;
2502 my $dbh = C4::Context->dbh;
2508 my $sth = $dbh->prepare($query);
2509 $sth->execute($invoiceid);
2511 $invoice = $sth->fetchrow_hashref;
2515 =head3 GetInvoiceDetails
2517 my $invoice = GetInvoiceDetails($invoiceid)
2519 Return informations about an invoice + the list of related order lines
2521 Orders informations are in $invoice->{orders} (array ref)
2525 sub GetInvoiceDetails {
2526 my ($invoiceid) = @_;
2528 if ( !defined $invoiceid ) {
2529 carp 'GetInvoiceDetails called without an invoiceid';
2533 my $dbh = C4::Context->dbh;
2535 SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2537 LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2540 my $sth = $dbh->prepare($query);
2541 $sth->execute($invoiceid);
2543 my $invoice = $sth->fetchrow_hashref;
2548 biblio.copyrightdate,
2550 biblioitems.publishercode,
2551 biblioitems.publicationyear,
2552 aqbasket.basketname,
2553 aqbasketgroups.id AS basketgroupid,
2554 aqbasketgroups.name AS basketgroupname
2556 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2557 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2558 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2559 LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2562 $sth = $dbh->prepare($query);
2563 $sth->execute($invoiceid);
2564 $invoice->{orders} = $sth->fetchall_arrayref({});
2565 $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2572 my $invoiceid = AddInvoice(
2573 invoicenumber => $invoicenumber,
2574 booksellerid => $booksellerid,
2575 shipmentdate => $shipmentdate,
2576 billingdate => $billingdate,
2577 closedate => $closedate,
2578 shipmentcost => $shipmentcost,
2579 shipmentcost_budgetid => $shipmentcost_budgetid
2582 Create a new invoice and return its id or undef if it fails.
2589 return unless(%invoice and $invoice{invoicenumber});
2591 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2592 closedate shipmentcost shipmentcost_budgetid message_id);
2596 foreach my $key (keys %invoice) {
2597 if(0 < grep { $_ eq $key } @columns) {
2598 push @set_strs, "$key = ?";
2599 push @set_args, ($invoice{$key} || undef);
2605 my $dbh = C4::Context->dbh;
2606 my $query = "INSERT INTO aqinvoices SET ";
2607 $query .= join (",", @set_strs);
2608 my $sth = $dbh->prepare($query);
2609 $rv = $sth->execute(@set_args);
2611 $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2620 invoiceid => $invoiceid, # Mandatory
2621 invoicenumber => $invoicenumber,
2622 booksellerid => $booksellerid,
2623 shipmentdate => $shipmentdate,
2624 billingdate => $billingdate,
2625 closedate => $closedate,
2626 shipmentcost => $shipmentcost,
2627 shipmentcost_budgetid => $shipmentcost_budgetid
2630 Modify an invoice, invoiceid is mandatory.
2632 Return undef if it fails.
2639 return unless(%invoice and $invoice{invoiceid});
2641 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2642 closedate shipmentcost shipmentcost_budgetid);
2646 foreach my $key (keys %invoice) {
2647 if(0 < grep { $_ eq $key } @columns) {
2648 push @set_strs, "$key = ?";
2649 push @set_args, ($invoice{$key} || undef);
2653 my $dbh = C4::Context->dbh;
2654 my $query = "UPDATE aqinvoices SET ";
2655 $query .= join(",", @set_strs);
2656 $query .= " WHERE invoiceid = ?";
2658 my $sth = $dbh->prepare($query);
2659 $sth->execute(@set_args, $invoice{invoiceid});
2664 CloseInvoice($invoiceid);
2668 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2673 my ($invoiceid) = @_;
2675 return unless $invoiceid;
2677 my $dbh = C4::Context->dbh;
2680 SET closedate = CAST(NOW() AS DATE)
2683 my $sth = $dbh->prepare($query);
2684 $sth->execute($invoiceid);
2687 =head3 ReopenInvoice
2689 ReopenInvoice($invoiceid);
2693 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2698 my ($invoiceid) = @_;
2700 return unless $invoiceid;
2702 my $dbh = C4::Context->dbh;
2705 SET closedate = NULL
2708 my $sth = $dbh->prepare($query);
2709 $sth->execute($invoiceid);
2714 DelInvoice($invoiceid);
2716 Delete an invoice if there are no items attached to it.
2721 my ($invoiceid) = @_;
2723 return unless $invoiceid;
2725 my $dbh = C4::Context->dbh;
2731 my $sth = $dbh->prepare($query);
2732 $sth->execute($invoiceid);
2733 my $res = $sth->fetchrow_arrayref;
2734 if ( $res && $res->[0] == 0 ) {
2736 DELETE FROM aqinvoices
2739 my $sth = $dbh->prepare($query);
2740 return ( $sth->execute($invoiceid) > 0 );
2745 =head3 MergeInvoices
2747 MergeInvoices($invoiceid, \@sourceids);
2749 Merge the invoices identified by the IDs in \@sourceids into
2750 the invoice identified by $invoiceid.
2755 my ($invoiceid, $sourceids) = @_;
2757 return unless $invoiceid;
2758 foreach my $sourceid (@$sourceids) {
2759 next if $sourceid == $invoiceid;
2760 my $source = GetInvoiceDetails($sourceid);
2761 foreach my $order (@{$source->{'orders'}}) {
2762 $order->{'invoiceid'} = $invoiceid;
2765 DelInvoice($source->{'invoiceid'});
2770 =head3 GetBiblioCountByBasketno
2772 $biblio_count = &GetBiblioCountByBasketno($basketno);
2774 Looks up the biblio's count that has basketno value $basketno
2780 sub GetBiblioCountByBasketno {
2781 my ($basketno) = @_;
2782 my $dbh = C4::Context->dbh;
2784 SELECT COUNT( DISTINCT( biblionumber ) )
2787 AND datecancellationprinted IS NULL
2790 my $sth = $dbh->prepare($query);
2791 $sth->execute($basketno);
2792 return $sth->fetchrow;
2795 =head3 populate_order_with_prices
2797 $order = populate_order_with_prices({
2798 order => $order #a hashref with the order values
2799 booksellerid => $booksellerid #FIXME - should obtain from order basket
2800 receiving => 1 # boolean representing order stage, should pass only this or ordering
2801 ordering => 1 # boolean representing order stage
2805 Sets calculated values for an order - all values are stored with full precision
2806 regardless of rounding preference except for tax value which is calculated
2807 on rounded values if requested
2809 For ordering the values set are:
2814 tax_value_on_ordering
2815 For receiving the value set are:
2816 unitprice_tax_included
2817 unitprice_tax_excluded
2818 tax_value_on_receiving
2820 Note: When receiving, if the rounded value of the unitprice matches the rounded
2821 value of the ecost then then ecost (full precision) is used.
2823 Returns a hashref of the order
2825 FIXME: Move this to Koha::Acquisition::Order.pm
2829 sub populate_order_with_prices {
2832 my $order = $params->{order};
2833 my $booksellerid = $params->{booksellerid};
2834 return unless $booksellerid;
2836 my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
2838 my $receiving = $params->{receiving};
2839 my $ordering = $params->{ordering};
2840 my $discount = $order->{discount};
2841 $discount /= 100 if $discount > 1;
2844 $order->{tax_rate_on_ordering} //= $order->{tax_rate};
2845 if ( $bookseller->listincgst ) {
2847 # The user entered the prices tax included
2848 $order->{unitprice} += 0;
2849 $order->{unitprice_tax_included} = $order->{unitprice};
2850 $order->{rrp_tax_included} = $order->{rrp};
2852 # price tax excluded = price tax included / ( 1 + tax rate )
2853 $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2854 $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2856 # ecost tax included = rrp tax included ( 1 - discount )
2857 $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
2859 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2860 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2862 # tax value = quantity * ecost tax excluded * tax rate
2863 # we should use the unitprice if included
2864 my $cost_tax_included = $order->{unitprice_tax_included} == 0 ? $order->{ecost_tax_included} : $order->{unitprice_tax_included};
2865 my $cost_tax_excluded = $order->{unitprice_tax_excluded} == 0 ? $order->{ecost_tax_excluded} : $order->{unitprice_tax_excluded};
2866 $order->{tax_value_on_ordering} = ( get_rounded_price($cost_tax_included) - get_rounded_price($cost_tax_excluded) ) * $order->{quantity};
2870 # The user entered the prices tax excluded
2871 $order->{unitprice_tax_excluded} = $order->{unitprice};
2872 $order->{rrp_tax_excluded} = $order->{rrp};
2874 # price tax included = price tax excluded * ( 1 - tax rate )
2875 $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2876 $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2878 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2879 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2881 # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount ) = ecost tax excluded * ( 1 + tax rate )
2882 $order->{ecost_tax_included} = $order->{ecost_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2884 # tax value = quantity * ecost tax included * tax rate
2885 # we should use the unitprice if included
2886 my $cost_tax_excluded = $order->{unitprice_tax_excluded} == 0 ? $order->{ecost_tax_excluded} : $order->{unitprice_tax_excluded};
2887 $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($cost_tax_excluded) * $order->{tax_rate_on_ordering};
2892 $order->{tax_rate_on_receiving} //= $order->{tax_rate};
2893 if ( $bookseller->invoiceincgst ) {
2894 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2895 # we need to keep the exact ecost value
2896 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
2897 $order->{unitprice} = $order->{ecost_tax_included};
2900 # The user entered the unit price tax included
2901 $order->{unitprice_tax_included} = $order->{unitprice};
2903 # unit price tax excluded = unit price tax included / ( 1 + tax rate )
2904 $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
2907 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2908 # we need to keep the exact ecost value
2909 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
2910 $order->{unitprice} = $order->{ecost_tax_excluded};
2913 # The user entered the unit price tax excluded
2914 $order->{unitprice_tax_excluded} = $order->{unitprice};
2917 # unit price tax included = unit price tax included * ( 1 + tax rate )
2918 $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
2921 # tax value = quantity * unit price tax excluded * tax rate
2922 $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
2928 =head3 GetOrderUsers
2930 $order_users_ids = &GetOrderUsers($ordernumber);
2932 Returns a list of all borrowernumbers that are in order users list
2937 my ($ordernumber) = @_;
2939 return unless $ordernumber;
2942 SELECT borrowernumber
2944 WHERE ordernumber = ?
2946 my $dbh = C4::Context->dbh;
2947 my $sth = $dbh->prepare($query);
2948 $sth->execute($ordernumber);
2949 my $results = $sth->fetchall_arrayref( {} );
2951 my @borrowernumbers;
2952 foreach (@$results) {
2953 push @borrowernumbers, $_->{'borrowernumber'};
2956 return @borrowernumbers;
2959 =head3 ModOrderUsers
2961 my @order_users_ids = (1, 2, 3);
2962 &ModOrderUsers($ordernumber, @basketusers_ids);
2964 Delete all users from order users list, and add users in C<@order_users_ids>
2970 my ( $ordernumber, @order_users_ids ) = @_;
2972 return unless $ordernumber;
2974 my $dbh = C4::Context->dbh;
2976 DELETE FROM aqorder_users
2977 WHERE ordernumber = ?
2979 my $sth = $dbh->prepare($query);
2980 $sth->execute($ordernumber);
2983 INSERT INTO aqorder_users (ordernumber, borrowernumber)
2986 $sth = $dbh->prepare($query);
2987 foreach my $order_user_id (@order_users_ids) {
2988 $sth->execute( $ordernumber, $order_user_id );
2992 sub NotifyOrderUsers {
2993 my ($ordernumber) = @_;
2995 my @borrowernumbers = GetOrderUsers($ordernumber);
2996 return unless @borrowernumbers;
2998 my $order = GetOrder( $ordernumber );
2999 for my $borrowernumber (@borrowernumbers) {
3000 my $patron = Koha::Patrons->find( $borrowernumber );
3001 my $library = $patron->library->unblessed;
3002 my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed;
3003 my $letter = C4::Letters::GetPreparedLetter(
3004 module => 'acquisition',
3005 letter_code => 'ACQ_NOTIF_ON_RECEIV',
3006 branchcode => $library->{branchcode},
3007 lang => $patron->lang,
3009 'branches' => $library,
3010 'borrowers' => $patron->unblessed,
3011 'biblio' => $biblio,
3012 'aqorders' => $order,
3016 C4::Letters::EnqueueLetter(
3019 borrowernumber => $borrowernumber,
3020 LibraryName => C4::Context->preference("LibraryName"),
3021 message_transport_type => 'email',
3023 ) or warn "can't enqueue letter $letter";
3028 =head3 FillWithDefaultValues
3030 FillWithDefaultValues( $marc_record, $params );
3032 This will update the record with default value defined in the ACQ framework.
3033 For all existing fields, if a default value exists and there are no subfield, it will be created.
3034 If the field does not exist, it will be created too.
3036 If the parameter only_mandatory => 1 is passed via $params, only the mandatory
3037 defaults are being applied to the record.
3041 sub FillWithDefaultValues {
3042 my ( $record, $params ) = @_;
3043 my $mandatory = $params->{only_mandatory};
3044 my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3047 C4::Biblio::GetMarcFromKohaField( 'items.itemnumber' );
3048 for my $tag ( sort keys %$tagslib ) {
3050 next if $tag == $itemfield;
3051 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3052 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3053 next if $mandatory && !$tagslib->{$tag}{$subfield}{mandatory};
3054 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3055 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3056 my @fields = $record->field($tag);
3058 for my $field (@fields) {
3059 if ( $field->is_control_field ) {
3060 $field->update($defaultvalue) if not defined $field->data;
3062 elsif ( not defined $field->subfield($subfield) ) {
3063 $field->add_subfields(
3064 $subfield => $defaultvalue );
3069 if ( $tag < 10 ) { # is_control_field
3070 $record->insert_fields_ordered(
3077 $record->insert_fields_ordered(
3079 $tag, '', '', $subfield => $defaultvalue
3095 Koha Development Team <http://koha-community.org/>