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>.
30 use C4::Log qw(logaction);
31 use C4::Templates qw(gettemplate);
32 use Koha::DateUtils qw( dt_from_string output_pref );
33 use Koha::Acquisition::Baskets;
34 use Koha::Acquisition::Booksellers;
35 use Koha::Acquisition::Orders;
39 use Koha::Number::Price;
41 use Koha::CsvProfiles;
51 use vars qw(@ISA @EXPORT);
57 &GetBasket &NewBasket &ReopenBasket &ModBasket
58 &GetBasketAsCSV &GetBasketGroupAsCSV
59 &GetBasketsByBookseller &GetBasketsByBasketgroup
60 &GetBasketsInfosByBookseller
62 &GetBasketUsers &ModBasketUsers
67 &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup
68 &GetBasketgroups &ReOpenBasketgroup
70 &ModOrder &GetOrder &GetOrders &GetOrdersByBiblionumber
71 &GetOrderFromItemnumber
72 &SearchOrders &GetHistory &GetRecentAcqui
73 &ModReceiveOrder &CancelReceipt
90 &GetBiblioCountByBasketno
96 &FillWithDefaultValues
107 sub GetOrderFromItemnumber {
108 my ($itemnumber) = @_;
109 my $dbh = C4::Context->dbh;
112 SELECT * from aqorders LEFT JOIN aqorders_items
113 ON ( aqorders.ordernumber = aqorders_items.ordernumber )
114 WHERE itemnumber = ? |;
116 my $sth = $dbh->prepare($query);
120 $sth->execute($itemnumber);
122 my $order = $sth->fetchrow_hashref;
129 C4::Acquisition - Koha functions for dealing with orders and acquisitions
137 The functions in this module deal with acquisitions, managing book
138 orders, basket and parcels.
142 =head2 FUNCTIONS ABOUT BASKETS
146 $aqbasket = &GetBasket($basketnumber);
148 get all basket informations in aqbasket for a given basket
150 B<returns:> informations for a given basket returned as a hashref.
156 my $dbh = C4::Context->dbh;
159 concat( b.firstname,' ',b.surname) AS authorisedbyname
161 LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
164 my $sth=$dbh->prepare($query);
165 $sth->execute($basketno);
166 my $basket = $sth->fetchrow_hashref;
170 #------------------------------------------------------------#
174 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
175 $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace, $is_standing, $create_items );
177 Create a new basket in aqbasket table
181 =item C<$booksellerid> is a foreign key in the aqbasket table
183 =item C<$authorizedby> is the username of who created the basket
187 The other parameters are optional, see ModBasketHeader for more info on them.
192 my ( $booksellerid, $authorisedby, $basketname, $basketnote,
193 $basketbooksellernote, $basketcontractnumber, $deliveryplace,
194 $billingplace, $is_standing, $create_items ) = @_;
195 my $dbh = C4::Context->dbh;
197 'INSERT INTO aqbasket (creationdate,booksellerid,authorisedby) '
198 . 'VALUES (now(),?,?)';
199 $dbh->do( $query, {}, $booksellerid, $authorisedby );
201 my $basket = $dbh->{mysql_insertid};
202 $basketname ||= q{}; # default to empty strings
204 $basketbooksellernote ||= q{};
205 ModBasketHeader( $basket, $basketname, $basketnote, $basketbooksellernote,
206 $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items );
208 # Log the basket creation
209 if (C4::Context->preference("AcqLog")) {
210 logaction('ACQUISITIONS', 'ADD_BASKET', $basket);
218 &ReopenBasket($basketno);
226 my $dbh = C4::Context->dbh;
227 $dbh->do( q{UPDATE aqbasket SET closedate=NULL WHERE basketno=?}, {}, $basketno );
231 SET orderstatus = 'new'
233 AND orderstatus NOT IN ( 'complete', 'cancelled' )
238 #------------------------------------------------------------#
240 =head3 GetBasketAsCSV
242 &GetBasketAsCSV($basketno);
244 Export a basket as CSV
246 $cgi parameter is needed for column name translation
251 my ($basketno, $cgi, $csv_profile_id) = @_;
252 my $basket = GetBasket($basketno);
253 my @orders = GetOrders($basketno);
254 my $contract = GetContract({
255 contractnumber => $basket->{'contractnumber'}
258 my $template = C4::Templates::gettemplate("acqui/csv/basket.tt", "intranet", $cgi);
260 if ($csv_profile_id) {
261 my $csv_profile = Koha::CsvProfiles->find( $csv_profile_id );
262 Koha::Exceptions::ObjectNotFound->throw( 'There is no valid csv profile given') unless $csv_profile;
264 my $csv = Text::CSV_XS->new({'quote_char'=>'"','escape_char'=>'"','sep_char'=>$csv_profile->csv_separator,'binary'=>1});
265 my $csv_profile_content = $csv_profile->content;
266 my ( @headers, @fields );
267 while ( $csv_profile_content =~ /
270 ([^\|]*) # fieldname (table.row or row)
274 my $field = ($2 eq '') ? $1 : $2;
276 $header =~ s/^\s+|\s+$//g; # Trim whitespaces
277 push @headers, $header;
279 $field =~ s/[^\.]*\.{1}//; # Remove the table name if exists.
280 $field =~ s/^\s+|\s+$//g; # Trim whitespaces
281 push @fields, $field;
283 for my $order (@orders) {
285 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
286 my $biblioitem = $biblio->biblioitem;
287 $order = { %$order, %{ $biblioitem->unblessed } };
289 $order = {%$order, %$contract};
291 $order = {%$order, %$basket, %{ $biblio->unblessed }};
292 for my $field (@fields) {
293 push @row, $order->{$field};
297 my $content = join( $csv_profile->csv_separator, @headers ) . "\n";
298 for my $row ( @rows ) {
299 $csv->combine(@$row);
300 my $string = $csv->string;
301 $content .= $string . "\n";
306 foreach my $order (@orders) {
307 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
308 my $biblioitem = $biblio->biblioitem;
310 contractname => $contract->{'contractname'},
311 ordernumber => $order->{'ordernumber'},
312 entrydate => $order->{'entrydate'},
313 isbn => $order->{'isbn'},
314 author => $biblio->author,
315 title => $biblio->title,
316 publicationyear => $biblioitem->publicationyear,
317 publishercode => $biblioitem->publishercode,
318 collectiontitle => $biblioitem->collectiontitle,
319 notes => $order->{'order_vendornote'},
320 quantity => $order->{'quantity'},
321 rrp => $order->{'rrp'},
323 for my $place ( qw( deliveryplace billingplace ) ) {
324 if ( my $library = Koha::Libraries->find( $row->{deliveryplace} ) ) {
325 $row->{$place} = $library->branchname
329 contractname author title publishercode collectiontitle notes
330 deliveryplace billingplace
332 # Double the quotes to not be interpreted as a field end
333 $row->{$_} =~ s/"/""/g if $row->{$_};
339 if(defined $a->{publishercode} and defined $b->{publishercode}) {
340 $a->{publishercode} cmp $b->{publishercode};
344 $template->param(rows => \@rows);
346 return $template->output;
351 =head3 GetBasketGroupAsCSV
353 &GetBasketGroupAsCSV($basketgroupid);
355 Export a basket group as CSV
357 $cgi parameter is needed for column name translation
361 sub GetBasketGroupAsCSV {
362 my ($basketgroupid, $cgi) = @_;
363 my $baskets = GetBasketsByBasketgroup($basketgroupid);
365 my $template = C4::Templates::gettemplate('acqui/csv/basketgroup.tt', 'intranet', $cgi);
368 for my $basket (@$baskets) {
369 my @orders = GetOrders( $basket->{basketno} );
370 my $contract = GetContract({
371 contractnumber => $basket->{contractnumber}
373 my $bookseller = Koha::Acquisition::Booksellers->find( $basket->{booksellerid} );
374 my $basketgroup = GetBasketgroup( $$basket{basketgroupid} );
376 foreach my $order (@orders) {
377 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
378 my $biblioitem = $biblio->biblioitem;
380 clientnumber => $bookseller->accountnumber,
381 basketname => $basket->{basketname},
382 ordernumber => $order->{ordernumber},
383 author => $biblio->author,
384 title => $biblio->title,
385 publishercode => $biblioitem->publishercode,
386 publicationyear => $biblioitem->publicationyear,
387 collectiontitle => $biblioitem->collectiontitle,
388 isbn => $order->{isbn},
389 quantity => $order->{quantity},
390 rrp_tax_included => $order->{rrp_tax_included},
391 rrp_tax_excluded => $order->{rrp_tax_excluded},
392 discount => $bookseller->discount,
393 ecost_tax_included => $order->{ecost_tax_included},
394 ecost_tax_excluded => $order->{ecost_tax_excluded},
395 notes => $order->{order_vendornote},
396 entrydate => $order->{entrydate},
397 booksellername => $bookseller->name,
398 bookselleraddress => $bookseller->address1,
399 booksellerpostal => $bookseller->postal,
400 contractnumber => $contract->{contractnumber},
401 contractname => $contract->{contractname},
404 basketgroupdeliveryplace => $basketgroup->{deliveryplace},
405 basketgroupbillingplace => $basketgroup->{billingplace},
406 basketdeliveryplace => $basket->{deliveryplace},
407 basketbillingplace => $basket->{billingplace},
409 for my $place (qw( basketgroupdeliveryplace basketgroupbillingplace basketdeliveryplace basketbillingplace )) {
410 if ( my $library = Koha::Libraries->find( $temp->{$place} ) ) {
411 $row->{$place} = $library->branchname;
415 basketname author title publishercode collectiontitle notes
416 booksellername bookselleraddress booksellerpostal contractname
417 basketgroupdeliveryplace basketgroupbillingplace
418 basketdeliveryplace basketbillingplace
420 # Double the quotes to not be interpreted as a field end
421 $row->{$_} =~ s/"/""/g if $row->{$_};
426 $template->param(rows => \@rows);
428 return $template->output;
432 =head3 CloseBasketgroup
434 &CloseBasketgroup($basketgroupno);
440 sub CloseBasketgroup {
441 my ($basketgroupno) = @_;
442 my $dbh = C4::Context->dbh;
443 my $sth = $dbh->prepare("
444 UPDATE aqbasketgroups
448 $sth->execute($basketgroupno);
451 #------------------------------------------------------------#
453 =head3 ReOpenBaskergroup($basketgroupno)
455 &ReOpenBaskergroup($basketgroupno);
461 sub ReOpenBasketgroup {
462 my ($basketgroupno) = @_;
463 my $dbh = C4::Context->dbh;
464 my $sth = $dbh->prepare("
465 UPDATE aqbasketgroups
469 $sth->execute($basketgroupno);
472 #------------------------------------------------------------#
476 &ModBasket($basketinfo);
478 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
482 =item C<$basketno> is the primary key of the basket in the aqbasket table.
489 my $basketinfo = shift;
490 my $query = "UPDATE aqbasket SET ";
492 foreach my $key (keys %$basketinfo){
493 if ($key ne 'basketno'){
494 $query .= "$key=?, ";
495 push(@params, $basketinfo->{$key} || undef );
498 # get rid of the "," at the end of $query
499 if (substr($query, length($query)-2) eq ', '){
504 $query .= "WHERE basketno=?";
505 push(@params, $basketinfo->{'basketno'});
506 my $dbh = C4::Context->dbh;
507 my $sth = $dbh->prepare($query);
508 $sth->execute(@params);
510 # Log the basket update
511 if (C4::Context->preference("AcqLog")) {
515 $basketinfo->{'basketno'}
522 #------------------------------------------------------------#
524 =head3 ModBasketHeader
526 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
528 Modifies a basket's header.
532 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
534 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
536 =item C<$note> is the "note" field in the "aqbasket" table;
538 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
540 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
542 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
544 =item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
546 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
548 =item C<$is_standing> is the "is_standing" field in the aqbasket table.
550 =item C<$create_items> should be set to 'ordering', 'receiving' or 'cataloguing' (or undef, in which
551 case the AcqCreateItem syspref takes precedence).
557 sub ModBasketHeader {
558 my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items) = @_;
563 SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=?, is_standing=?, create_items=?
567 my $dbh = C4::Context->dbh;
568 my $sth = $dbh->prepare($query);
569 $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items || undef, $basketno);
571 if ( $contractnumber ) {
572 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
573 my $sth2 = $dbh->prepare($query2);
574 $sth2->execute($contractnumber,$basketno);
580 #------------------------------------------------------------#
582 =head3 GetBasketsByBookseller
584 @results = &GetBasketsByBookseller($booksellerid, $extra);
586 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
590 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
592 =item C<$extra> is the extra sql parameters, can be
594 $extra->{groupby}: group baskets by column
595 ex. $extra->{groupby} = aqbasket.basketgroupid
596 $extra->{orderby}: order baskets by column
597 $extra->{limit}: limit number of results (can be helpful for pagination)
603 sub GetBasketsByBookseller {
604 my ($booksellerid, $extra) = @_;
605 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
607 if ($extra->{groupby}) {
608 $query .= " GROUP by $extra->{groupby}";
610 if ($extra->{orderby}){
611 $query .= " ORDER by $extra->{orderby}";
613 if ($extra->{limit}){
614 $query .= " LIMIT $extra->{limit}";
617 my $dbh = C4::Context->dbh;
618 my $sth = $dbh->prepare($query);
619 $sth->execute($booksellerid);
620 return $sth->fetchall_arrayref({});
623 =head3 GetBasketsInfosByBookseller
625 my $baskets = GetBasketsInfosByBookseller($supplierid, $allbaskets);
627 The optional second parameter allbaskets is a boolean allowing you to
628 select all baskets from the supplier; by default only active baskets (open or
629 closed but still something to receive) are returned.
631 Returns in a arrayref of hashref all about booksellers baskets, plus:
632 total_biblios: Number of distinct biblios in basket
633 total_items: Number of items in basket
634 expected_items: Number of non-received items in basket
638 sub GetBasketsInfosByBookseller {
639 my ($supplierid, $allbaskets) = @_;
641 return unless $supplierid;
643 my $dbh = C4::Context->dbh;
645 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,
646 SUM(aqorders.quantity) AS total_items,
648 IF ( aqorders.orderstatus = 'cancelled', aqorders.quantity, 0 )
649 ) AS total_items_cancelled,
650 COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
652 IF(aqorders.datereceived IS NULL
653 AND aqorders.datecancellationprinted IS NULL
657 SUM( aqorders.uncertainprice ) AS uncertainprices
659 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
660 WHERE booksellerid = ?};
662 $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";
664 unless ( $allbaskets ) {
665 # Don't show the basket if it's NOT CLOSED or is FULLY RECEIVED
666 $query.=" HAVING (closedate IS NULL OR (
668 IF(aqorders.datereceived IS NULL
669 AND aqorders.datecancellationprinted IS NULL
675 my $sth = $dbh->prepare($query);
676 $sth->execute($supplierid);
677 my $baskets = $sth->fetchall_arrayref({});
679 # Retrieve the number of biblios cancelled
680 my $cancelled_biblios = $dbh->selectall_hashref( q|
681 SELECT COUNT(DISTINCT(biblionumber)) AS total_biblios_cancelled, aqbasket.basketno
683 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
684 WHERE booksellerid = ?
685 AND aqorders.orderstatus = 'cancelled'
686 GROUP BY aqbasket.basketno
687 |, 'basketno', {}, $supplierid );
689 $_->{total_biblios_cancelled} = $cancelled_biblios->{$_->{basketno}}{total_biblios_cancelled} || 0
695 =head3 GetBasketUsers
697 $basketusers_ids = &GetBasketUsers($basketno);
699 Returns a list of all borrowernumbers that are in basket users list
704 my $basketno = shift;
706 return unless $basketno;
709 SELECT borrowernumber
713 my $dbh = C4::Context->dbh;
714 my $sth = $dbh->prepare($query);
715 $sth->execute($basketno);
716 my $results = $sth->fetchall_arrayref( {} );
719 foreach (@$results) {
720 push @borrowernumbers, $_->{'borrowernumber'};
723 return @borrowernumbers;
726 =head3 ModBasketUsers
728 my @basketusers_ids = (1, 2, 3);
729 &ModBasketUsers($basketno, @basketusers_ids);
731 Delete all users from basket users list, and add users in C<@basketusers_ids>
737 my ($basketno, @basketusers_ids) = @_;
739 return unless $basketno;
741 my $dbh = C4::Context->dbh;
743 DELETE FROM aqbasketusers
746 my $sth = $dbh->prepare($query);
747 $sth->execute($basketno);
750 INSERT INTO aqbasketusers (basketno, borrowernumber)
753 $sth = $dbh->prepare($query);
754 foreach my $basketuser_id (@basketusers_ids) {
755 $sth->execute($basketno, $basketuser_id);
760 =head3 CanUserManageBasket
762 my $bool = CanUserManageBasket($borrower, $basket[, $userflags]);
763 my $bool = CanUserManageBasket($borrowernumber, $basketno[, $userflags]);
765 Check if a borrower can manage a basket, according to system preference
766 AcqViewBaskets, user permissions and basket properties (creator, users list,
769 First parameter can be either a borrowernumber or a hashref as returned by
770 Koha::Patron->unblessed
772 Second parameter can be either a basketno or a hashref as returned by
773 C4::Acquisition::GetBasket.
775 The third parameter is optional. If given, it should be a hashref as returned
776 by C4::Auth::getuserflags. If not, getuserflags is called.
778 If user is authorised to manage basket, returns 1.
783 sub CanUserManageBasket {
784 my ($borrower, $basket, $userflags) = @_;
786 if (!ref $borrower) {
787 # FIXME This needs to be replaced
788 # We should not accept both scalar and array
789 # Tests need to be updated
790 $borrower = Koha::Patrons->find( $borrower )->unblessed;
793 $basket = GetBasket($basket);
796 return 0 unless ($basket and $borrower);
798 my $borrowernumber = $borrower->{borrowernumber};
799 my $basketno = $basket->{basketno};
801 my $AcqViewBaskets = C4::Context->preference('AcqViewBaskets');
803 if (!defined $userflags) {
804 my $dbh = C4::Context->dbh;
805 my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE borrowernumber = ?");
806 $sth->execute($borrowernumber);
807 my ($flags) = $sth->fetchrow_array;
810 $userflags = C4::Auth::getuserflags($flags, $borrower->{userid}, $dbh);
813 unless ($userflags->{superlibrarian}
814 || (ref $userflags->{acquisition} && $userflags->{acquisition}->{order_manage_all})
815 || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
817 if (not exists $userflags->{acquisition}) {
821 if ( (ref $userflags->{acquisition} && !$userflags->{acquisition}->{order_manage})
822 || (!ref $userflags->{acquisition} && !$userflags->{acquisition}) ) {
826 if ($AcqViewBaskets eq 'user'
827 && $basket->{authorisedby} != $borrowernumber
828 && ! grep { $borrowernumber eq $_ } GetBasketUsers($basketno)) {
832 if ($AcqViewBaskets eq 'branch' && defined $basket->{branch}
833 && $basket->{branch} ne $borrower->{branchcode}) {
841 #------------------------------------------------------------#
843 =head3 GetBasketsByBasketgroup
845 $baskets = &GetBasketsByBasketgroup($basketgroupid);
847 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
851 sub GetBasketsByBasketgroup {
852 my $basketgroupid = shift;
854 SELECT *, aqbasket.booksellerid as booksellerid
856 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?
858 my $dbh = C4::Context->dbh;
859 my $sth = $dbh->prepare($query);
860 $sth->execute($basketgroupid);
861 return $sth->fetchall_arrayref({});
864 #------------------------------------------------------------#
866 =head3 NewBasketgroup
868 $basketgroupid = NewBasketgroup(\%hashref);
870 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
872 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
874 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
876 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
878 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
880 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
882 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
884 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
886 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
891 my $basketgroupinfo = shift;
892 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
893 my $query = "INSERT INTO aqbasketgroups (";
895 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
896 if ( defined $basketgroupinfo->{$field} ) {
897 $query .= "$field, ";
898 push(@params, $basketgroupinfo->{$field});
901 $query .= "booksellerid) VALUES (";
906 push(@params, $basketgroupinfo->{'booksellerid'});
907 my $dbh = C4::Context->dbh;
908 my $sth = $dbh->prepare($query);
909 $sth->execute(@params);
910 my $basketgroupid = $dbh->{'mysql_insertid'};
911 if( $basketgroupinfo->{'basketlist'} ) {
912 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
913 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
914 my $sth2 = $dbh->prepare($query2);
915 $sth2->execute($basketgroupid, $basketno);
918 return $basketgroupid;
921 #------------------------------------------------------------#
923 =head3 ModBasketgroup
925 ModBasketgroup(\%hashref);
927 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
929 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
931 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
933 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
935 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
937 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
939 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
941 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
943 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
948 my $basketgroupinfo = shift;
949 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
950 my $dbh = C4::Context->dbh;
951 my $query = "UPDATE aqbasketgroups SET ";
953 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
954 if ( defined $basketgroupinfo->{$field} ) {
955 $query .= "$field=?, ";
956 push(@params, $basketgroupinfo->{$field});
961 $query .= " WHERE id=?";
962 push(@params, $basketgroupinfo->{'id'});
963 my $sth = $dbh->prepare($query);
964 $sth->execute(@params);
966 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
967 $sth->execute($basketgroupinfo->{'id'});
969 if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
970 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
971 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
972 $sth->execute($basketgroupinfo->{'id'}, $basketno);
978 #------------------------------------------------------------#
980 =head3 DelBasketgroup
982 DelBasketgroup($basketgroupid);
984 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
988 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
995 my $basketgroupid = shift;
996 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
997 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
998 my $dbh = C4::Context->dbh;
999 my $sth = $dbh->prepare($query);
1000 $sth->execute($basketgroupid);
1004 #------------------------------------------------------------#
1007 =head2 FUNCTIONS ABOUT ORDERS
1009 =head3 GetBasketgroup
1011 $basketgroup = &GetBasketgroup($basketgroupid);
1013 Returns a reference to the hash containing all information about the basketgroup.
1017 sub GetBasketgroup {
1018 my $basketgroupid = shift;
1019 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1020 my $dbh = C4::Context->dbh;
1021 my $result_set = $dbh->selectall_arrayref(
1022 'SELECT * FROM aqbasketgroups WHERE id=?',
1026 return $result_set->[0]; # id is unique
1029 #------------------------------------------------------------#
1031 =head3 GetBasketgroups
1033 $basketgroups = &GetBasketgroups($booksellerid);
1035 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
1039 sub GetBasketgroups {
1040 my $booksellerid = shift;
1041 die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
1042 my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
1043 my $dbh = C4::Context->dbh;
1044 my $sth = $dbh->prepare($query);
1045 $sth->execute($booksellerid);
1046 return $sth->fetchall_arrayref({});
1049 #------------------------------------------------------------#
1051 =head2 FUNCTIONS ABOUT ORDERS
1055 @orders = &GetOrders( $basketno, { orderby => 'biblio.title', cancelled => 0|1 } );
1057 Looks up the pending (non-cancelled) orders with the given basket
1060 If cancelled is set, only cancelled orders will be returned.
1065 my ( $basketno, $params ) = @_;
1067 return () unless $basketno;
1069 my $orderby = $params->{orderby};
1070 my $cancelled = $params->{cancelled} || 0;
1072 my $dbh = C4::Context->dbh;
1074 SELECT biblio.*,biblioitems.*,
1078 $query .= $cancelled
1080 aqorders_transfers.ordernumber_to AS transferred_to,
1081 aqorders_transfers.timestamp AS transferred_to_timestamp
1084 aqorders_transfers.ordernumber_from AS transferred_from,
1085 aqorders_transfers.timestamp AS transferred_from_timestamp
1089 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1090 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1091 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1093 $query .= $cancelled
1095 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
1098 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1106 $orderby ||= q|biblioitems.publishercode, biblio.title|;
1108 AND datecancellationprinted IS NOT NULL
1113 q|aqorders.datecancellationprinted desc, aqorders.timestamp desc|;
1115 AND datecancellationprinted IS NULL
1119 $query .= " ORDER BY $orderby";
1121 $dbh->selectall_arrayref( $query, { Slice => {} }, $basketno );
1126 #------------------------------------------------------------#
1128 =head3 GetOrdersByBiblionumber
1130 @orders = &GetOrdersByBiblionumber($biblionumber);
1132 Looks up the orders with linked to a specific $biblionumber, including
1133 cancelled orders and received orders.
1136 C<@orders> is an array of references-to-hash, whose keys are the
1137 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
1141 sub GetOrdersByBiblionumber {
1142 my $biblionumber = shift;
1143 return unless $biblionumber;
1144 my $dbh = C4::Context->dbh;
1146 SELECT biblio.*,biblioitems.*,
1150 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1151 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1152 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1153 WHERE aqorders.biblionumber=?
1156 $dbh->selectall_arrayref( $query, { Slice => {} }, $biblionumber );
1157 return @{$result_set};
1161 #------------------------------------------------------------#
1165 $order = &GetOrder($ordernumber);
1167 Looks up an order by order number.
1169 Returns a reference-to-hash describing the order. The keys of
1170 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1175 my ($ordernumber) = @_;
1176 return unless $ordernumber;
1178 my $dbh = C4::Context->dbh;
1179 my $query = qq{SELECT
1183 aqbasket.basketname,
1184 borrowers.branchcode,
1185 biblioitems.publicationyear,
1186 biblio.copyrightdate,
1187 biblioitems.editionstatement,
1191 biblioitems.publishercode,
1192 aqorders.rrp AS unitpricesupplier,
1193 aqorders.ecost AS unitpricelib,
1194 aqbudgets.budget_name AS budget,
1195 aqbooksellers.name AS supplier,
1196 aqbooksellers.id AS supplierid,
1197 biblioitems.publishercode AS publisher,
1198 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1199 DATE(aqbasket.closedate) AS orderdate,
1200 aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity_to_receive,
1201 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1202 DATEDIFF(CURDATE( ),closedate) AS latesince
1203 FROM aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1204 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1205 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1206 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
1207 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1208 WHERE aqorders.basketno = aqbasket.basketno
1211 $dbh->selectall_arrayref( $query, { Slice => {} }, $ordernumber );
1213 # result_set assumed to contain 1 match
1214 return $result_set->[0];
1219 &ModOrder(\%hashref);
1221 Modifies an existing order. Updates the order with order number
1222 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1223 other keys of the hash update the fields with the same name in the aqorders
1224 table of the Koha database.
1229 my $orderinfo = shift;
1231 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '';
1233 my $dbh = C4::Context->dbh;
1236 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1237 $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1239 # delete($orderinfo->{'branchcode'});
1240 # the hash contains a lot of entries not in aqorders, so get the columns ...
1241 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1243 my $colnames = $sth->{NAME};
1244 #FIXME Be careful. If aqorders would have columns with diacritics,
1245 #you should need to decode what you get back from NAME.
1246 #See report 10110 and guided_reports.pl
1247 my $query = "UPDATE aqorders SET ";
1249 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1250 # ... and skip hash entries that are not in the aqorders table
1251 # FIXME : probably not the best way to do it (would be better to have a correct hash)
1252 next unless grep { $_ eq $orderinfokey } @$colnames;
1253 $query .= "$orderinfokey=?, ";
1254 push(@params, $orderinfo->{$orderinfokey});
1257 $query .= "timestamp=NOW() WHERE ordernumber=?";
1258 push(@params, $orderinfo->{'ordernumber'} );
1259 $sth = $dbh->prepare($query);
1260 $sth->execute(@params);
1264 #------------------------------------------------------------#
1268 ModItemOrder($itemnumber, $ordernumber);
1270 Modifies the ordernumber of an item in aqorders_items.
1275 my ($itemnumber, $ordernumber) = @_;
1277 return unless ($itemnumber and $ordernumber);
1279 my $dbh = C4::Context->dbh;
1281 UPDATE aqorders_items
1283 WHERE itemnumber = ?
1285 my $sth = $dbh->prepare($query);
1286 return $sth->execute($ordernumber, $itemnumber);
1289 #------------------------------------------------------------#
1291 =head3 ModReceiveOrder
1293 my ( $date_received, $new_ordernumber ) = ModReceiveOrder(
1295 biblionumber => $biblionumber,
1297 quantityreceived => $quantityreceived,
1299 invoice => $invoice,
1300 budget_id => $budget_id,
1301 datereceived => $datereceived,
1302 received_itemnumbers => \@received_itemnumbers,
1306 Updates an order, to reflect the fact that it was received, at least
1309 If a partial order is received, splits the order into two.
1311 Updates the order with biblionumber C<$biblionumber> and ordernumber
1312 C<$order->{ordernumber}>.
1317 sub ModReceiveOrder {
1319 my $biblionumber = $params->{biblionumber};
1320 my $order = { %{ $params->{order} } }; # Copy the order, we don't want to modify it
1321 my $invoice = $params->{invoice};
1322 my $quantrec = $params->{quantityreceived};
1323 my $user = $params->{user};
1324 my $budget_id = $params->{budget_id};
1325 my $datereceived = $params->{datereceived};
1326 my $received_items = $params->{received_items};
1328 my $dbh = C4::Context->dbh;
1329 $datereceived = output_pref(
1331 dt => ( $datereceived ? dt_from_string( $datereceived ) : dt_from_string ),
1332 dateformat => 'iso',
1337 my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1338 if ($suggestionid) {
1339 ModSuggestion( {suggestionid=>$suggestionid,
1340 STATUS=>'AVAILABLE',
1341 biblionumber=> $biblionumber}
1345 my $result_set = $dbh->selectrow_arrayref(
1346 q{SELECT aqbasket.is_standing
1348 WHERE basketno=?},{ Slice => {} }, $order->{basketno});
1349 my $is_standing = $result_set->[0]; # we assume we have a unique basket
1351 my $new_ordernumber = $order->{ordernumber};
1352 if ( $is_standing || $order->{quantity} > $quantrec ) {
1353 # Split order line in two parts: the first is the original order line
1354 # without received items (the quantity is decreased),
1355 # the second part is a new order line with quantity=quantityrec
1356 # (entirely received)
1360 orderstatus = 'partial'|;
1361 $query .= q| WHERE ordernumber = ?|;
1362 my $sth = $dbh->prepare($query);
1365 ( $is_standing ? 1 : ($order->{quantity} - $quantrec) ),
1366 $order->{ordernumber}
1369 if ( not $order->{subscriptionid} && defined $order->{order_internalnote} ) {
1372 SET order_internalnote = ?
1373 WHERE ordernumber = ?|, {},
1374 $order->{order_internalnote}, $order->{ordernumber}
1378 # Recalculate tax_value
1382 tax_value_on_ordering = quantity * | . get_rounding_sql(q|ecost_tax_excluded|) . q| * tax_rate_on_ordering,
1383 tax_value_on_receiving = quantity * | . get_rounding_sql(q|unitprice_tax_excluded|) . q| * tax_rate_on_receiving
1384 WHERE ordernumber = ?
1385 |, undef, $order->{ordernumber});
1387 delete $order->{ordernumber};
1388 $order->{budget_id} = ( $budget_id || $order->{budget_id} );
1389 $order->{quantity} = $quantrec;
1390 $order->{quantityreceived} = $quantrec;
1391 $order->{ecost_tax_excluded} //= 0;
1392 $order->{tax_rate_on_ordering} //= 0;
1393 $order->{unitprice_tax_excluded} //= 0;
1394 $order->{tax_rate_on_receiving} //= 0;
1395 $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($order->{ecost_tax_excluded}) * $order->{tax_rate_on_ordering};
1396 $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
1397 $order->{datereceived} = $datereceived;
1398 $order->{invoiceid} = $invoice->{invoiceid};
1399 $order->{orderstatus} = 'complete';
1400 $new_ordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber; # TODO What if the store fails?
1402 if ($received_items) {
1403 foreach my $itemnumber (@$received_items) {
1404 ModItemOrder($itemnumber, $new_ordernumber);
1410 SET quantityreceived = ?,
1414 orderstatus = 'complete'
1418 , replacementprice = ?
1419 | if defined $order->{replacementprice};
1422 , unitprice = ?, unitprice_tax_included = ?, unitprice_tax_excluded = ?
1423 | if defined $order->{unitprice};
1426 ,tax_value_on_receiving = ?
1427 | if defined $order->{tax_value_on_receiving};
1430 ,tax_rate_on_receiving = ?
1431 | if defined $order->{tax_rate_on_receiving};
1434 , order_internalnote = ?
1435 | if defined $order->{order_internalnote};
1437 $query .= q| where biblionumber=? and ordernumber=?|;
1439 my $sth = $dbh->prepare( $query );
1440 my @params = ( $quantrec, $datereceived, $invoice->{invoiceid}, ( $budget_id ? $budget_id : $order->{budget_id} ) );
1442 if ( defined $order->{replacementprice} ) {
1443 push @params, $order->{replacementprice};
1446 if ( defined $order->{unitprice} ) {
1447 push @params, $order->{unitprice}, $order->{unitprice_tax_included}, $order->{unitprice_tax_excluded};
1450 if ( defined $order->{tax_value_on_receiving} ) {
1451 push @params, $order->{tax_value_on_receiving};
1454 if ( defined $order->{tax_rate_on_receiving} ) {
1455 push @params, $order->{tax_rate_on_receiving};
1458 if ( defined $order->{order_internalnote} ) {
1459 push @params, $order->{order_internalnote};
1462 push @params, ( $biblionumber, $order->{ordernumber} );
1464 $sth->execute( @params );
1466 # All items have been received, sent a notification to users
1467 NotifyOrderUsers( $order->{ordernumber} );
1470 return ($datereceived, $new_ordernumber);
1473 =head3 CancelReceipt
1475 my $parent_ordernumber = CancelReceipt($ordernumber);
1477 Cancel an order line receipt and update the parent order line, as if no
1479 If items are created at receipt (AcqCreateItem = receiving) then delete
1485 my $ordernumber = shift;
1487 return unless $ordernumber;
1489 my $dbh = C4::Context->dbh;
1491 SELECT datereceived, parent_ordernumber, quantity
1493 WHERE ordernumber = ?
1495 my $sth = $dbh->prepare($query);
1496 $sth->execute($ordernumber);
1497 my $order = $sth->fetchrow_hashref;
1499 warn "CancelReceipt: order $ordernumber does not exist";
1502 unless($order->{'datereceived'}) {
1503 warn "CancelReceipt: order $ordernumber is not received";
1507 my $parent_ordernumber = $order->{'parent_ordernumber'};
1509 my $order_obj = Koha::Acquisition::Orders->find( $ordernumber ); # FIXME rewrite all this subroutine using this object
1510 my @itemnumbers = $order_obj->items->get_column('itemnumber');
1512 if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1513 # The order line has no parent, just mark it as not received
1516 SET quantityreceived = ?,
1519 orderstatus = 'ordered'
1520 WHERE ordernumber = ?
1522 $sth = $dbh->prepare($query);
1523 $sth->execute(0, undef, undef, $ordernumber);
1524 _cancel_items_receipt( $order_obj );
1526 # The order line has a parent, increase parent quantity and delete
1528 unless ( $order_obj->basket->is_standing ) {
1530 SELECT quantity, datereceived
1532 WHERE ordernumber = ?
1534 $sth = $dbh->prepare($query);
1535 $sth->execute($parent_ordernumber);
1536 my $parent_order = $sth->fetchrow_hashref;
1537 unless($parent_order) {
1538 warn "Parent order $parent_ordernumber does not exist.";
1541 if($parent_order->{'datereceived'}) {
1542 warn "CancelReceipt: parent order is received.".
1543 " Can't cancel receipt.";
1549 orderstatus = 'ordered'
1550 WHERE ordernumber = ?
1552 $sth = $dbh->prepare($query);
1553 my $rv = $sth->execute(
1554 $order->{'quantity'} + $parent_order->{'quantity'},
1558 warn "Cannot update parent order line, so do not cancel".
1563 # Recalculate tax_value
1567 tax_value_on_ordering = quantity * | . get_rounding_sql(q|ecost_tax_excluded|) . q| * tax_rate_on_ordering,
1568 tax_value_on_receiving = quantity * | . get_rounding_sql(q|unitprice_tax_excluded|) . q| * tax_rate_on_receiving
1569 WHERE ordernumber = ?
1570 |, undef, $parent_ordernumber);
1573 _cancel_items_receipt( $order_obj, $parent_ordernumber );
1576 DELETE FROM aqorders
1577 WHERE ordernumber = ?
1579 $sth = $dbh->prepare($query);
1580 $sth->execute($ordernumber);
1584 if( $order_obj->basket->effective_create_items eq 'ordering' ) {
1585 my @affects = split q{\|}, C4::Context->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1587 for my $in ( @itemnumbers ) {
1588 my $item = Koha::Items->find( $in ); # FIXME We do not need that, we already have Koha::Items from $order_obj->items
1589 my $biblio = $item->biblio;
1590 my ( $itemfield ) = GetMarcFromKohaField( 'items.itemnumber' );
1591 my $item_marc = C4::Items::GetMarcItem( $biblio->biblionumber, $in );
1592 for my $affect ( @affects ) {
1593 my ( $sf, $v ) = split q{=}, $affect, 2;
1594 foreach ( $item_marc->field($itemfield) ) {
1595 $_->update( $sf => $v );
1598 C4::Items::ModItemFromMarc( $item_marc, $biblio->biblionumber, $in );
1603 return $parent_ordernumber;
1606 sub _cancel_items_receipt {
1607 my ( $order, $parent_ordernumber ) = @_;
1608 $parent_ordernumber ||= $order->ordernumber;
1610 my $items = $order->items;
1611 if ( $order->basket->effective_create_items eq 'receiving' ) {
1612 # Remove items that were created at receipt
1614 DELETE FROM items, aqorders_items
1615 USING items, aqorders_items
1616 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1618 my $dbh = C4::Context->dbh;
1619 my $sth = $dbh->prepare($query);
1620 while ( my $item = $items->next ) {
1621 $sth->execute($item->itemnumber, $item->itemnumber);
1625 while ( my $item = $items->next ) {
1626 ModItemOrder($item->itemnumber, $parent_ordernumber);
1631 #------------------------------------------------------------#
1635 @results = &SearchOrders({
1636 ordernumber => $ordernumber,
1639 booksellerid => $booksellerid,
1640 basketno => $basketno,
1641 basketname => $basketname,
1642 basketgroupname => $basketgroupname,
1646 biblionumber => $biblionumber,
1647 budget_id => $budget_id
1650 Searches for orders filtered by criteria.
1652 C<$ordernumber> Finds matching orders or transferred orders by ordernumber.
1653 C<$search> Finds orders matching %$search% in title, author, or isbn.
1654 C<$owner> Finds order for the logged in user.
1655 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1656 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1659 C<@results> is an array of references-to-hash with the keys are fields
1660 from aqorders, biblio, biblioitems and aqbasket tables.
1665 my ( $params ) = @_;
1666 my $ordernumber = $params->{ordernumber};
1667 my $search = $params->{search};
1668 my $ean = $params->{ean};
1669 my $booksellerid = $params->{booksellerid};
1670 my $basketno = $params->{basketno};
1671 my $basketname = $params->{basketname};
1672 my $basketgroupname = $params->{basketgroupname};
1673 my $owner = $params->{owner};
1674 my $pending = $params->{pending};
1675 my $ordered = $params->{ordered};
1676 my $biblionumber = $params->{biblionumber};
1677 my $budget_id = $params->{budget_id};
1679 my $dbh = C4::Context->dbh;
1682 SELECT aqbasket.basketno,
1684 borrowers.firstname,
1687 biblioitems.biblioitemnumber,
1688 biblioitems.publishercode,
1689 biblioitems.publicationyear,
1690 aqbasket.authorisedby,
1691 aqbasket.booksellerid,
1693 aqbasket.creationdate,
1694 aqbasket.basketname,
1695 aqbasketgroups.id as basketgroupid,
1696 aqbasketgroups.name as basketgroupname,
1699 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1700 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1701 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1702 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1703 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1706 # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
1708 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1712 WHERE (datecancellationprinted is NULL)
1715 if ( $pending or $ordered ) {
1718 ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) )
1720 ( quantity > quantityreceived OR quantityreceived is NULL )
1724 $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1732 my $userenv = C4::Context->userenv;
1733 if ( C4::Context->preference("IndependentBranches") ) {
1734 unless ( C4::Context->IsSuperLibrarian() ) {
1737 borrowers.branchcode = ?
1738 OR borrowers.branchcode = ''
1741 push @args, $userenv->{branch};
1745 if ( $ordernumber ) {
1746 $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1747 push @args, ( $ordernumber, $ordernumber );
1749 if ( $biblionumber ) {
1750 $query .= 'AND aqorders.biblionumber = ?';
1751 push @args, $biblionumber;
1754 $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1755 push @args, ("%$search%","%$search%","%$search%");
1758 $query .= ' AND biblioitems.ean = ?';
1761 if ( $booksellerid ) {
1762 $query .= 'AND aqbasket.booksellerid = ?';
1763 push @args, $booksellerid;
1766 $query .= 'AND aqbasket.basketno = ?';
1767 push @args, $basketno;
1770 $query .= 'AND aqbasket.basketname LIKE ?';
1771 push @args, "%$basketname%";
1773 if( $basketgroupname ) {
1774 $query .= ' AND aqbasketgroups.name LIKE ?';
1775 push @args, "%$basketgroupname%";
1779 $query .= ' AND aqbasket.authorisedby=? ';
1780 push @args, $userenv->{'number'};
1784 $query .= ' AND aqorders.budget_id = ?';
1785 push @args, $budget_id;
1788 $query .= ' ORDER BY aqbasket.basketno';
1790 my $sth = $dbh->prepare($query);
1791 $sth->execute(@args);
1792 return $sth->fetchall_arrayref({});
1795 #------------------------------------------------------------#
1797 =head3 TransferOrder
1799 my $newordernumber = TransferOrder($ordernumber, $basketno);
1801 Transfer an order line to a basket.
1802 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1803 to BOOKSELLER on DATE' and create new order with internal note
1804 'Transferred from BOOKSELLER on DATE'.
1805 Move all attached items to the new order.
1806 Received orders cannot be transferred.
1807 Return the ordernumber of created order.
1812 my ($ordernumber, $basketno) = @_;
1814 return unless ($ordernumber and $basketno);
1816 my $order = Koha::Acquisition::Orders->find( $ordernumber ) or return;
1817 return if $order->datereceived;
1819 $order = $order->unblessed;
1821 my $basket = GetBasket($basketno);
1822 return unless $basket;
1824 my $dbh = C4::Context->dbh;
1825 my ($query, $sth, $rv);
1829 SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1830 WHERE ordernumber = ?
1832 $sth = $dbh->prepare($query);
1833 $rv = $sth->execute('cancelled', $ordernumber);
1835 delete $order->{'ordernumber'};
1836 delete $order->{parent_ordernumber};
1837 $order->{'basketno'} = $basketno;
1839 my $newordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber;
1842 UPDATE aqorders_items
1844 WHERE ordernumber = ?
1846 $sth = $dbh->prepare($query);
1847 $sth->execute($newordernumber, $ordernumber);
1850 INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1853 $sth = $dbh->prepare($query);
1854 $sth->execute($ordernumber, $newordernumber);
1856 return $newordernumber;
1859 =head3 get_rounding_sql
1861 $rounding_sql = get_rounding_sql($column_name);
1863 returns the correct SQL routine based on OrderPriceRounding system preference.
1867 sub get_rounding_sql {
1868 my ( $round_string ) = @_;
1869 my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
1870 if ( $rounding_pref eq "nearest_cent" ) {
1871 return "CAST($round_string*100 AS SIGNED)/100";
1873 return $round_string;
1876 =head3 get_rounded_price
1878 $rounded_price = get_rounded_price( $price );
1880 returns a price rounded as specified in OrderPriceRounding system preference.
1884 sub get_rounded_price {
1886 my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
1887 if( $rounding_pref eq 'nearest_cent' ) {
1888 return Koha::Number::Price->new( $price )->round();
1894 =head2 FUNCTIONS ABOUT PARCELS
1898 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1900 get a lists of parcels.
1907 is the bookseller this function has to get parcels.
1910 To know on what criteria the results list has to be ordered.
1913 is the booksellerinvoicenumber.
1915 =item $datefrom & $dateto
1916 to know on what date this function has to filter its search.
1921 a pointer on a hash list containing parcel informations as such :
1927 =item Last operation
1929 =item Number of biblio
1931 =item Number of items
1938 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1939 my $dbh = C4::Context->dbh;
1940 my @query_params = ();
1942 SELECT aqinvoices.invoicenumber,
1943 datereceived,purchaseordernumber,
1944 count(DISTINCT biblionumber) AS biblio,
1945 sum(quantity) AS itemsexpected,
1946 sum(quantityreceived) AS itemsreceived
1947 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1948 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1949 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1951 push @query_params, $bookseller;
1953 if ( defined $code ) {
1954 $strsth .= ' and aqinvoices.invoicenumber like ? ';
1955 # add a % to the end of the code to allow stemming.
1956 push @query_params, "$code%";
1959 if ( defined $datefrom ) {
1960 $strsth .= ' and datereceived >= ? ';
1961 push @query_params, $datefrom;
1964 if ( defined $dateto ) {
1965 $strsth .= 'and datereceived <= ? ';
1966 push @query_params, $dateto;
1969 $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
1971 # can't use a placeholder to place this column name.
1972 # but, we could probably be checking to make sure it is a column that will be fetched.
1973 $strsth .= "order by $order " if ($order);
1975 my $sth = $dbh->prepare($strsth);
1977 $sth->execute( @query_params );
1978 my $results = $sth->fetchall_arrayref({});
1982 #------------------------------------------------------------#
1986 \@order_loop = GetHistory( %params );
1988 Retreives some acquisition history information
1998 basket - search both basket name and number
1999 booksellerinvoicenumber
2002 orderstatus (note that orderstatus '' will retrieve orders
2003 of any status except cancelled)
2007 get_canceled_order (if set to a true value, cancelled orders will
2011 $order_loop is a list of hashrefs that each look like this:
2013 'author' => 'Twain, Mark',
2015 'biblionumber' => '215',
2017 'creationdate' => 'MM/DD/YYYY',
2018 'datereceived' => undef,
2021 'invoicenumber' => undef,
2023 'ordernumber' => '1',
2025 'quantityreceived' => undef,
2026 'title' => 'The Adventures of Huckleberry Finn',
2027 'managing_library' => 'CPL'
2028 'is_standing' => '1'
2034 # don't run the query if there are no parameters (list would be too long for sure !)
2035 croak "No search params" unless @_;
2037 my $title = $params{title};
2038 my $author = $params{author};
2039 my $isbn = $params{isbn};
2040 my $ean = $params{ean};
2041 my $name = $params{name};
2042 my $from_placed_on = $params{from_placed_on};
2043 my $to_placed_on = $params{to_placed_on};
2044 my $basket = $params{basket};
2045 my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2046 my $basketgroupname = $params{basketgroupname};
2047 my $budget = $params{budget};
2048 my $orderstatus = $params{orderstatus};
2049 my $is_standing = $params{is_standing};
2050 my $biblionumber = $params{biblionumber};
2051 my $get_canceled_order = $params{get_canceled_order} || 0;
2052 my $ordernumber = $params{ordernumber};
2053 my $search_children_too = $params{search_children_too} || 0;
2054 my $created_by = $params{created_by} || [];
2055 my $managing_library = $params{managing_library};
2056 my $ordernumbers = $params{ordernumbers} || [];
2057 my $additional_fields = $params{additional_fields} // [];
2060 my $total_qtyreceived = 0;
2061 my $total_price = 0;
2063 #get variation of isbn
2067 if ( C4::Context->preference("SearchWithISBNVariations") ){
2068 @isbns = C4::Koha::GetVariationsOfISBN( $isbn );
2069 foreach my $isb (@isbns){
2070 push @isbn_params, '?';
2075 push @isbn_params, '?';
2079 my $dbh = C4::Context->dbh;
2082 COALESCE(biblio.title, deletedbiblio.title) AS title,
2083 COALESCE(biblio.author, deletedbiblio.author) AS author,
2084 COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2085 COALESCE(biblioitems.ean, deletedbiblioitems.ean) AS ean,
2087 aqbasket.basketname,
2088 aqbasket.basketgroupid,
2089 aqbasket.authorisedby,
2090 aqbasket.is_standing,
2091 concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2092 branch as managing_library,
2093 aqbasketgroups.name as groupname,
2095 aqbasket.creationdate,
2096 aqorders.datereceived,
2098 aqorders.quantityreceived,
2100 aqorders.ordernumber,
2102 aqinvoices.invoicenumber,
2103 aqbooksellers.id as id,
2104 aqorders.biblionumber,
2105 aqorders.orderstatus,
2106 aqorders.parent_ordernumber,
2107 aqbudgets.budget_name
2109 $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2112 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2113 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2114 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2115 LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2116 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2117 LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2118 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2119 LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2120 LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2121 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2124 $query .= " WHERE 1 ";
2126 unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2127 $query .= " AND datecancellationprinted IS NULL ";
2130 my @query_params = ();
2132 if ( $biblionumber ) {
2133 $query .= " AND biblio.biblionumber = ?";
2134 push @query_params, $biblionumber;
2138 $query .= " AND biblio.title LIKE ? ";
2139 $title =~ s/\s+/%/g;
2140 push @query_params, "%$title%";
2144 $query .= " AND biblio.author LIKE ? ";
2145 push @query_params, "%$author%";
2149 $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2150 foreach my $isb (@isbns){
2151 push @query_params, "%$isb%";
2156 $query .= " AND biblioitems.ean = ? ";
2157 push @query_params, "$ean";
2160 $query .= " AND aqbooksellers.name LIKE ? ";
2161 push @query_params, "%$name%";
2165 $query .= " AND aqbudgets.budget_id = ? ";
2166 push @query_params, "$budget";
2169 if ( $from_placed_on ) {
2170 $query .= " AND creationdate >= ? ";
2171 push @query_params, $from_placed_on;
2174 if ( $to_placed_on ) {
2175 $query .= " AND creationdate <= ? ";
2176 push @query_params, $to_placed_on;
2179 if ( defined $orderstatus and $orderstatus ne '') {
2180 $query .= " AND aqorders.orderstatus = ? ";
2181 push @query_params, "$orderstatus";
2184 if ( $is_standing ) {
2185 $query .= " AND is_standing = ? ";
2186 push @query_params, $is_standing;
2190 if ($basket =~ m/^\d+$/) {
2191 $query .= " AND aqorders.basketno = ? ";
2192 push @query_params, $basket;
2194 $query .= " AND aqbasket.basketname LIKE ? ";
2195 push @query_params, "%$basket%";
2199 if ($booksellerinvoicenumber) {
2200 $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2201 push @query_params, "%$booksellerinvoicenumber%";
2204 if ($basketgroupname) {
2205 $query .= " AND aqbasketgroups.name LIKE ? ";
2206 push @query_params, "%$basketgroupname%";
2210 $query .= " AND (aqorders.ordernumber = ? ";
2211 push @query_params, $ordernumber;
2212 if ($search_children_too) {
2213 $query .= " OR aqorders.parent_ordernumber = ? ";
2214 push @query_params, $ordernumber;
2219 if ( @$created_by ) {
2220 $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2221 push @query_params, @$created_by;
2224 if ( $managing_library ) {
2225 $query .= " AND aqbasket.branch = ? ";
2226 push @query_params, $managing_library;
2229 if ( @$ordernumbers ) {
2230 $query .= ' AND (aqorders.ordernumber IN ( ' . join (',', ('?') x @$ordernumbers ) . '))';
2231 push @query_params, @$ordernumbers;
2233 if ( @$additional_fields ) {
2234 my @baskets = Koha::Acquisition::Baskets->filter_by_additional_fields($additional_fields);
2236 return [] unless @baskets;
2238 # No parameterization because record IDs come directly from DB
2239 $query .= ' AND aqbasket.basketno IN ( ' . join( ',', map { $_->basketno } @baskets ) . ' )';
2242 if ( C4::Context->preference("IndependentBranches") ) {
2243 unless ( C4::Context->IsSuperLibrarian() ) {
2244 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2245 push @query_params, C4::Context->userenv->{branch};
2248 $query .= " ORDER BY id";
2250 return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2253 =head2 GetRecentAcqui
2255 $results = GetRecentAcqui($days);
2257 C<$results> is a ref to a table which contains hashref
2261 sub GetRecentAcqui {
2263 my $dbh = C4::Context->dbh;
2267 ORDER BY timestamp DESC
2270 my $sth = $dbh->prepare($query);
2272 my $results = $sth->fetchall_arrayref({});
2276 #------------------------------------------------------------#
2280 &AddClaim($ordernumber);
2282 Add a claim for an order
2287 my ($ordernumber) = @_;
2288 my $dbh = C4::Context->dbh;
2291 claims_count = claims_count + 1,
2292 claimed_date = CURDATE()
2293 WHERE ordernumber = ?
2295 my $sth = $dbh->prepare($query);
2296 $sth->execute($ordernumber);
2301 my @invoices = GetInvoices(
2302 invoicenumber => $invoicenumber,
2303 supplierid => $supplierid,
2304 suppliername => $suppliername,
2305 shipmentdatefrom => $shipmentdatefrom, # ISO format
2306 shipmentdateto => $shipmentdateto, # ISO format
2307 billingdatefrom => $billingdatefrom, # ISO format
2308 billingdateto => $billingdateto, # ISO format
2309 isbneanissn => $isbn_or_ean_or_issn,
2312 publisher => $publisher,
2313 publicationyear => $publicationyear,
2314 branchcode => $branchcode,
2315 order_by => $order_by
2318 Return a list of invoices that match all given criteria.
2320 $order_by is "column_name (asc|desc)", where column_name is any of
2321 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2322 'shipmentcost', 'shipmentcost_budgetid'.
2324 asc is the default if omitted
2331 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2332 closedate shipmentcost shipmentcost_budgetid);
2334 my $dbh = C4::Context->dbh;
2336 SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
2337 aqbooksellers.name AS suppliername,
2340 aqorders.datereceived IS NOT NULL,
2341 aqorders.biblionumber,
2344 ) AS receivedbiblios,
2347 aqorders.subscriptionid IS NOT NULL,
2348 aqorders.subscriptionid,
2351 ) AS is_linked_to_subscriptions,
2352 SUM(aqorders.quantityreceived) AS receiveditems
2354 LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2355 LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2356 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2357 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2358 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2359 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2360 LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2365 if($args{supplierid}) {
2366 push @bind_strs, " aqinvoices.booksellerid = ? ";
2367 push @bind_args, $args{supplierid};
2369 if($args{invoicenumber}) {
2370 push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2371 push @bind_args, "%$args{invoicenumber}%";
2373 if($args{suppliername}) {
2374 push @bind_strs, " aqbooksellers.name LIKE ? ";
2375 push @bind_args, "%$args{suppliername}%";
2377 if($args{shipmentdatefrom}) {
2378 push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2379 push @bind_args, $args{shipmentdatefrom};
2381 if($args{shipmentdateto}) {
2382 push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2383 push @bind_args, $args{shipmentdateto};
2385 if($args{billingdatefrom}) {
2386 push @bind_strs, " aqinvoices.billingdate >= ? ";
2387 push @bind_args, $args{billingdatefrom};
2389 if($args{billingdateto}) {
2390 push @bind_strs, " aqinvoices.billingdate <= ? ";
2391 push @bind_args, $args{billingdateto};
2393 if($args{isbneanissn}) {
2394 push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2395 push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2398 push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2399 push @bind_args, $args{title};
2402 push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2403 push @bind_args, $args{author};
2405 if($args{publisher}) {
2406 push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2407 push @bind_args, $args{publisher};
2409 if($args{publicationyear}) {
2410 push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2411 push @bind_args, $args{publicationyear}, $args{publicationyear};
2413 if($args{branchcode}) {
2414 push @bind_strs, " borrowers.branchcode = ? ";
2415 push @bind_args, $args{branchcode};
2417 if($args{message_id}) {
2418 push @bind_strs, " aqinvoices.message_id = ? ";
2419 push @bind_args, $args{message_id};
2422 $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2423 $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";
2425 if($args{order_by}) {
2426 my ($column, $direction) = split / /, $args{order_by};
2427 if(grep { $_ eq $column } @columns) {
2428 $direction ||= 'ASC';
2429 $query .= " ORDER BY $column $direction";
2433 my $sth = $dbh->prepare($query);
2434 $sth->execute(@bind_args);
2436 my $results = $sth->fetchall_arrayref({});
2442 my $invoice = GetInvoice($invoiceid);
2444 Get informations about invoice with given $invoiceid
2446 Return a hash filled with aqinvoices.* fields
2451 my ($invoiceid) = @_;
2454 return unless $invoiceid;
2456 my $dbh = C4::Context->dbh;
2462 my $sth = $dbh->prepare($query);
2463 $sth->execute($invoiceid);
2465 $invoice = $sth->fetchrow_hashref;
2469 =head3 GetInvoiceDetails
2471 my $invoice = GetInvoiceDetails($invoiceid)
2473 Return informations about an invoice + the list of related order lines
2475 Orders informations are in $invoice->{orders} (array ref)
2479 sub GetInvoiceDetails {
2480 my ($invoiceid) = @_;
2482 if ( !defined $invoiceid ) {
2483 carp 'GetInvoiceDetails called without an invoiceid';
2487 my $dbh = C4::Context->dbh;
2489 SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2491 LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2494 my $sth = $dbh->prepare($query);
2495 $sth->execute($invoiceid);
2497 my $invoice = $sth->fetchrow_hashref;
2502 biblio.copyrightdate,
2504 biblioitems.publishercode,
2505 biblioitems.publicationyear,
2506 aqbasket.basketname,
2507 aqbasketgroups.id AS basketgroupid,
2508 aqbasketgroups.name AS basketgroupname
2510 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2511 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2512 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2513 LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2516 $sth = $dbh->prepare($query);
2517 $sth->execute($invoiceid);
2518 $invoice->{orders} = $sth->fetchall_arrayref({});
2519 $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2526 my $invoiceid = AddInvoice(
2527 invoicenumber => $invoicenumber,
2528 booksellerid => $booksellerid,
2529 shipmentdate => $shipmentdate,
2530 billingdate => $billingdate,
2531 closedate => $closedate,
2532 shipmentcost => $shipmentcost,
2533 shipmentcost_budgetid => $shipmentcost_budgetid
2536 Create a new invoice and return its id or undef if it fails.
2543 return unless(%invoice and $invoice{invoicenumber});
2545 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2546 closedate shipmentcost shipmentcost_budgetid message_id);
2550 foreach my $key (keys %invoice) {
2551 if(0 < grep { $_ eq $key } @columns) {
2552 push @set_strs, "$key = ?";
2553 push @set_args, ($invoice{$key} || undef);
2559 my $dbh = C4::Context->dbh;
2560 my $query = "INSERT INTO aqinvoices SET ";
2561 $query .= join (",", @set_strs);
2562 my $sth = $dbh->prepare($query);
2563 $rv = $sth->execute(@set_args);
2565 $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2574 invoiceid => $invoiceid, # Mandatory
2575 invoicenumber => $invoicenumber,
2576 booksellerid => $booksellerid,
2577 shipmentdate => $shipmentdate,
2578 billingdate => $billingdate,
2579 closedate => $closedate,
2580 shipmentcost => $shipmentcost,
2581 shipmentcost_budgetid => $shipmentcost_budgetid
2584 Modify an invoice, invoiceid is mandatory.
2586 Return undef if it fails.
2593 return unless(%invoice and $invoice{invoiceid});
2595 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2596 closedate shipmentcost shipmentcost_budgetid);
2600 foreach my $key (keys %invoice) {
2601 if(0 < grep { $_ eq $key } @columns) {
2602 push @set_strs, "$key = ?";
2603 push @set_args, ($invoice{$key} || undef);
2607 my $dbh = C4::Context->dbh;
2608 my $query = "UPDATE aqinvoices SET ";
2609 $query .= join(",", @set_strs);
2610 $query .= " WHERE invoiceid = ?";
2612 my $sth = $dbh->prepare($query);
2613 $sth->execute(@set_args, $invoice{invoiceid});
2618 CloseInvoice($invoiceid);
2622 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2627 my ($invoiceid) = @_;
2629 return unless $invoiceid;
2631 my $dbh = C4::Context->dbh;
2634 SET closedate = CAST(NOW() AS DATE)
2637 my $sth = $dbh->prepare($query);
2638 $sth->execute($invoiceid);
2641 =head3 ReopenInvoice
2643 ReopenInvoice($invoiceid);
2647 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2652 my ($invoiceid) = @_;
2654 return unless $invoiceid;
2656 my $dbh = C4::Context->dbh;
2659 SET closedate = NULL
2662 my $sth = $dbh->prepare($query);
2663 $sth->execute($invoiceid);
2668 DelInvoice($invoiceid);
2670 Delete an invoice if there are no items attached to it.
2675 my ($invoiceid) = @_;
2677 return unless $invoiceid;
2679 my $dbh = C4::Context->dbh;
2685 my $sth = $dbh->prepare($query);
2686 $sth->execute($invoiceid);
2687 my $res = $sth->fetchrow_arrayref;
2688 if ( $res && $res->[0] == 0 ) {
2690 DELETE FROM aqinvoices
2693 my $sth = $dbh->prepare($query);
2694 return ( $sth->execute($invoiceid) > 0 );
2699 =head3 MergeInvoices
2701 MergeInvoices($invoiceid, \@sourceids);
2703 Merge the invoices identified by the IDs in \@sourceids into
2704 the invoice identified by $invoiceid.
2709 my ($invoiceid, $sourceids) = @_;
2711 return unless $invoiceid;
2712 foreach my $sourceid (@$sourceids) {
2713 next if $sourceid == $invoiceid;
2714 my $source = GetInvoiceDetails($sourceid);
2715 foreach my $order (@{$source->{'orders'}}) {
2716 $order->{'invoiceid'} = $invoiceid;
2719 DelInvoice($source->{'invoiceid'});
2724 =head3 GetBiblioCountByBasketno
2726 $biblio_count = &GetBiblioCountByBasketno($basketno);
2728 Looks up the biblio's count that has basketno value $basketno
2734 sub GetBiblioCountByBasketno {
2735 my ($basketno) = @_;
2736 my $dbh = C4::Context->dbh;
2738 SELECT COUNT( DISTINCT( biblionumber ) )
2741 AND datecancellationprinted IS NULL
2744 my $sth = $dbh->prepare($query);
2745 $sth->execute($basketno);
2746 return $sth->fetchrow;
2749 =head3 populate_order_with_prices
2751 $order = populate_order_with_prices({
2752 order => $order #a hashref with the order values
2753 booksellerid => $booksellerid #FIXME - should obtain from order basket
2754 receiving => 1 # boolean representing order stage, should pass only this or ordering
2755 ordering => 1 # boolean representing order stage
2759 Sets calculated values for an order - all values are stored with full precision
2760 regardless of rounding preference except for tax value which is calculated
2761 on rounded values if requested
2763 For ordering the values set are:
2768 tax_value_on_ordering
2769 For receiving the value set are:
2770 unitprice_tax_included
2771 unitprice_tax_excluded
2772 tax_value_on_receiving
2774 Note: When receiving, if the rounded value of the unitprice matches the rounded
2775 value of the ecost then then ecost (full precision) is used.
2777 Returns a hashref of the order
2779 FIXME: Move this to Koha::Acquisition::Order.pm
2783 sub populate_order_with_prices {
2786 my $order = $params->{order};
2787 my $booksellerid = $params->{booksellerid};
2788 return unless $booksellerid;
2790 my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
2792 my $receiving = $params->{receiving};
2793 my $ordering = $params->{ordering};
2794 my $discount = $order->{discount};
2795 $discount /= 100 if $discount > 1;
2798 $order->{tax_rate_on_ordering} //= $order->{tax_rate};
2799 if ( $bookseller->listincgst ) {
2801 # The user entered the prices tax included
2802 $order->{unitprice} += 0;
2803 $order->{unitprice_tax_included} = $order->{unitprice};
2804 $order->{rrp_tax_included} = $order->{rrp};
2806 # price tax excluded = price tax included / ( 1 + tax rate )
2807 $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2808 $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2810 # ecost tax included = rrp tax included ( 1 - discount )
2811 $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
2813 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2814 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2816 # tax value = quantity * ecost tax excluded * tax rate
2817 # we should use the unitprice if included
2818 my $cost_tax_included = $order->{unitprice_tax_included} || $order->{ecost_tax_included};
2819 my $cost_tax_excluded = $order->{unitprice_tax_excluded} || $order->{ecost_tax_excluded};
2820 $order->{tax_value_on_ordering} = ( get_rounded_price($cost_tax_included) - get_rounded_price($cost_tax_excluded) ) * $order->{quantity};
2824 # The user entered the prices tax excluded
2825 $order->{unitprice_tax_excluded} = $order->{unitprice};
2826 $order->{rrp_tax_excluded} = $order->{rrp};
2828 # price tax included = price tax excluded * ( 1 - tax rate )
2829 $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2830 $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2832 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2833 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2835 # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount ) = ecost tax excluded * ( 1 + tax rate )
2836 $order->{ecost_tax_included} = $order->{ecost_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2838 # tax value = quantity * ecost tax included * tax rate
2839 # we should use the unitprice if included
2840 my $cost_tax_excluded = $order->{unitprice_tax_excluded} || $order->{ecost_tax_excluded};
2841 $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($cost_tax_excluded) * $order->{tax_rate_on_ordering};
2846 $order->{tax_rate_on_receiving} //= $order->{tax_rate};
2847 if ( $bookseller->invoiceincgst ) {
2848 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2849 # we need to keep the exact ecost value
2850 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
2851 $order->{unitprice} = $order->{ecost_tax_included};
2854 # The user entered the unit price tax included
2855 $order->{unitprice_tax_included} = $order->{unitprice};
2857 # unit price tax excluded = unit price tax included / ( 1 + tax rate )
2858 $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
2861 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2862 # we need to keep the exact ecost value
2863 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
2864 $order->{unitprice} = $order->{ecost_tax_excluded};
2867 # The user entered the unit price tax excluded
2868 $order->{unitprice_tax_excluded} = $order->{unitprice};
2871 # unit price tax included = unit price tax included * ( 1 + tax rate )
2872 $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
2875 # tax value = quantity * unit price tax excluded * tax rate
2876 $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
2882 =head3 GetOrderUsers
2884 $order_users_ids = &GetOrderUsers($ordernumber);
2886 Returns a list of all borrowernumbers that are in order users list
2891 my ($ordernumber) = @_;
2893 return unless $ordernumber;
2896 SELECT borrowernumber
2898 WHERE ordernumber = ?
2900 my $dbh = C4::Context->dbh;
2901 my $sth = $dbh->prepare($query);
2902 $sth->execute($ordernumber);
2903 my $results = $sth->fetchall_arrayref( {} );
2905 my @borrowernumbers;
2906 foreach (@$results) {
2907 push @borrowernumbers, $_->{'borrowernumber'};
2910 return @borrowernumbers;
2913 =head3 ModOrderUsers
2915 my @order_users_ids = (1, 2, 3);
2916 &ModOrderUsers($ordernumber, @basketusers_ids);
2918 Delete all users from order users list, and add users in C<@order_users_ids>
2924 my ( $ordernumber, @order_users_ids ) = @_;
2926 return unless $ordernumber;
2928 my $dbh = C4::Context->dbh;
2930 DELETE FROM aqorder_users
2931 WHERE ordernumber = ?
2933 my $sth = $dbh->prepare($query);
2934 $sth->execute($ordernumber);
2937 INSERT INTO aqorder_users (ordernumber, borrowernumber)
2940 $sth = $dbh->prepare($query);
2941 foreach my $order_user_id (@order_users_ids) {
2942 $sth->execute( $ordernumber, $order_user_id );
2946 sub NotifyOrderUsers {
2947 my ($ordernumber) = @_;
2949 my @borrowernumbers = GetOrderUsers($ordernumber);
2950 return unless @borrowernumbers;
2952 my $order = GetOrder( $ordernumber );
2953 for my $borrowernumber (@borrowernumbers) {
2954 my $patron = Koha::Patrons->find( $borrowernumber );
2955 my $library = $patron->library->unblessed;
2956 my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed;
2957 my $letter = C4::Letters::GetPreparedLetter(
2958 module => 'acquisition',
2959 letter_code => 'ACQ_NOTIF_ON_RECEIV',
2960 branchcode => $library->{branchcode},
2961 lang => $patron->lang,
2963 'branches' => $library,
2964 'borrowers' => $patron->unblessed,
2965 'biblio' => $biblio,
2966 'aqorders' => $order,
2970 C4::Letters::EnqueueLetter(
2973 borrowernumber => $borrowernumber,
2974 LibraryName => C4::Context->preference("LibraryName"),
2975 message_transport_type => 'email',
2977 ) or warn "can't enqueue letter $letter";
2982 =head3 FillWithDefaultValues
2984 FillWithDefaultValues( $marc_record, $params );
2986 This will update the record with default value defined in the ACQ framework.
2987 For all existing fields, if a default value exists and there are no subfield, it will be created.
2988 If the field does not exist, it will be created too.
2990 If the parameter only_mandatory => 1 is passed via $params, only the mandatory
2991 defaults are being applied to the record.
2995 sub FillWithDefaultValues {
2996 my ( $record, $params ) = @_;
2997 my $mandatory = $params->{only_mandatory};
2998 my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3001 C4::Biblio::GetMarcFromKohaField( 'items.itemnumber' );
3002 for my $tag ( sort keys %$tagslib ) {
3004 next if $tag == $itemfield;
3005 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3006 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3007 next if $mandatory && !$tagslib->{$tag}{$subfield}{mandatory};
3008 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3009 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3010 my @fields = $record->field($tag);
3012 for my $field (@fields) {
3013 if ( $field->is_control_field ) {
3014 $field->update($defaultvalue) if not defined $field->data;
3016 elsif ( not defined $field->subfield($subfield) ) {
3017 $field->add_subfields(
3018 $subfield => $defaultvalue );
3023 if ( $tag < 10 ) { # is_control_field
3024 $record->insert_fields_ordered(
3031 $record->insert_fields_ordered(
3033 $tag, '', '', $subfield => $defaultvalue
3049 Koha Development Team <http://koha-community.org/>