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>.
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;
49 use vars qw(@ISA @EXPORT);
55 &GetBasket &NewBasket &CloseBasket &ReopenBasket &DelBasket &ModBasket
56 &GetBasketAsCSV &GetBasketGroupAsCSV
57 &GetBasketsByBookseller &GetBasketsByBasketgroup
58 &GetBasketsInfosByBookseller
60 &GetBasketUsers &ModBasketUsers
65 &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup
66 &GetBasketgroups &ReOpenBasketgroup
68 &DelOrder &ModOrder &GetOrder &GetOrders &GetOrdersByBiblionumber
69 &GetLateOrders &GetOrderFromItemnumber
70 &SearchOrders &GetHistory &GetRecentAcqui
71 &ModReceiveOrder &CancelReceipt
73 &GetLastOrderNotReceivedFromSubscriptionid &GetLastOrderReceivedFromSubscriptionid
89 &GetBiblioCountByBasketno
95 &FillWithDefaultValues
103 sub GetOrderFromItemnumber {
104 my ($itemnumber) = @_;
105 my $dbh = C4::Context->dbh;
108 SELECT * from aqorders LEFT JOIN aqorders_items
109 ON ( aqorders.ordernumber = aqorders_items.ordernumber )
110 WHERE itemnumber = ? |;
112 my $sth = $dbh->prepare($query);
116 $sth->execute($itemnumber);
118 my $order = $sth->fetchrow_hashref;
125 C4::Acquisition - Koha functions for dealing with orders and acquisitions
133 The functions in this module deal with acquisitions, managing book
134 orders, basket and parcels.
138 =head2 FUNCTIONS ABOUT BASKETS
142 $aqbasket = &GetBasket($basketnumber);
144 get all basket informations in aqbasket for a given basket
146 B<returns:> informations for a given basket returned as a hashref.
152 my $dbh = C4::Context->dbh;
155 concat( b.firstname,' ',b.surname) AS authorisedbyname
157 LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
160 my $sth=$dbh->prepare($query);
161 $sth->execute($basketno);
162 my $basket = $sth->fetchrow_hashref;
166 #------------------------------------------------------------#
170 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
171 $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace, $is_standing, $create_items );
173 Create a new basket in aqbasket table
177 =item C<$booksellerid> is a foreign key in the aqbasket table
179 =item C<$authorizedby> is the username of who created the basket
183 The other parameters are optional, see ModBasketHeader for more info on them.
188 my ( $booksellerid, $authorisedby, $basketname, $basketnote,
189 $basketbooksellernote, $basketcontractnumber, $deliveryplace,
190 $billingplace, $is_standing, $create_items ) = @_;
191 my $dbh = C4::Context->dbh;
193 'INSERT INTO aqbasket (creationdate,booksellerid,authorisedby) '
194 . 'VALUES (now(),?,?)';
195 $dbh->do( $query, {}, $booksellerid, $authorisedby );
197 my $basket = $dbh->{mysql_insertid};
198 $basketname ||= q{}; # default to empty strings
200 $basketbooksellernote ||= q{};
201 ModBasketHeader( $basket, $basketname, $basketnote, $basketbooksellernote,
202 $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items );
206 #------------------------------------------------------------#
210 &CloseBasket($basketno);
212 close a basket (becomes unmodifiable, except for receives)
218 my $dbh = C4::Context->dbh;
219 $dbh->do('UPDATE aqbasket SET closedate=now() WHERE basketno=?', {}, $basketno );
222 q{UPDATE aqorders SET orderstatus = 'ordered' WHERE basketno = ? AND orderstatus NOT IN ( 'complete', 'cancelled')},
230 &ReopenBasket($basketno);
238 my $dbh = C4::Context->dbh;
239 $dbh->do( q{UPDATE aqbasket SET closedate=NULL WHERE basketno=?}, {}, $basketno );
243 SET orderstatus = 'new'
245 AND orderstatus NOT IN ( 'complete', 'cancelled' )
250 #------------------------------------------------------------#
252 =head3 GetBasketAsCSV
254 &GetBasketAsCSV($basketno);
256 Export a basket as CSV
258 $cgi parameter is needed for column name translation
263 my ($basketno, $cgi, $csv_profile_id) = @_;
264 my $basket = GetBasket($basketno);
265 my @orders = GetOrders($basketno);
266 my $contract = GetContract({
267 contractnumber => $basket->{'contractnumber'}
270 my $template = C4::Templates::gettemplate("acqui/csv/basket.tt", "intranet", $cgi);
272 if ($csv_profile_id) {
273 my $csv_profile = Koha::CsvProfiles->find( $csv_profile_id );
274 Koha::Exceptions::ObjectNotFound->throw( 'There is no valid csv profile given') unless $csv_profile;
276 my $csv = Text::CSV_XS->new({'quote_char'=>'"','escape_char'=>'"','sep_char'=>$csv_profile->csv_separator,'binary'=>1});
277 my $csv_profile_content = $csv_profile->content;
278 my ( @headers, @fields );
279 while ( $csv_profile_content =~ /
282 ([^\|]*) # fieldname (table.row or row)
286 my $field = ($2 eq '') ? $1 : $2;
288 $header =~ s/^\s+|\s+$//g; # Trim whitespaces
289 push @headers, $header;
291 $field =~ s/[^\.]*\.{1}//; # Remove the table name if exists.
292 $field =~ s/^\s+|\s+$//g; # Trim whitespaces
293 push @fields, $field;
295 for my $order (@orders) {
297 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
298 my $biblioitem = $biblio->biblioitem;
299 $order = { %$order, %{ $biblioitem->unblessed } };
301 $order = {%$order, %$contract};
303 $order = {%$order, %$basket, %{ $biblio->unblessed }};
304 for my $field (@fields) {
305 push @row, $order->{$field};
309 my $content = join( $csv_profile->csv_separator, @headers ) . "\n";
310 for my $row ( @rows ) {
311 $csv->combine(@$row);
312 my $string = $csv->string;
313 $content .= $string . "\n";
318 foreach my $order (@orders) {
319 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
320 my $biblioitem = $biblio->biblioitem;
322 contractname => $contract->{'contractname'},
323 ordernumber => $order->{'ordernumber'},
324 entrydate => $order->{'entrydate'},
325 isbn => $order->{'isbn'},
326 author => $biblio->author,
327 title => $biblio->title,
328 publicationyear => $biblioitem->publicationyear,
329 publishercode => $biblioitem->publishercode,
330 collectiontitle => $biblioitem->collectiontitle,
331 notes => $order->{'order_vendornote'},
332 quantity => $order->{'quantity'},
333 rrp => $order->{'rrp'},
335 for my $place ( qw( deliveryplace billingplace ) ) {
336 if ( my $library = Koha::Libraries->find( $row->{deliveryplace} ) ) {
337 $row->{$place} = $library->branchname
341 contractname author title publishercode collectiontitle notes
342 deliveryplace billingplace
344 # Double the quotes to not be interpreted as a field end
345 $row->{$_} =~ s/"/""/g if $row->{$_};
351 if(defined $a->{publishercode} and defined $b->{publishercode}) {
352 $a->{publishercode} cmp $b->{publishercode};
356 $template->param(rows => \@rows);
358 return $template->output;
363 =head3 GetBasketGroupAsCSV
365 &GetBasketGroupAsCSV($basketgroupid);
367 Export a basket group as CSV
369 $cgi parameter is needed for column name translation
373 sub GetBasketGroupAsCSV {
374 my ($basketgroupid, $cgi) = @_;
375 my $baskets = GetBasketsByBasketgroup($basketgroupid);
377 my $template = C4::Templates::gettemplate('acqui/csv/basketgroup.tt', 'intranet', $cgi);
380 for my $basket (@$baskets) {
381 my @orders = GetOrders( $basket->{basketno} );
382 my $contract = GetContract({
383 contractnumber => $basket->{contractnumber}
385 my $bookseller = Koha::Acquisition::Booksellers->find( $basket->{booksellerid} );
386 my $basketgroup = GetBasketgroup( $$basket{basketgroupid} );
388 foreach my $order (@orders) {
389 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
390 my $biblioitem = $biblio->biblioitem;
392 clientnumber => $bookseller->accountnumber,
393 basketname => $basket->{basketname},
394 ordernumber => $order->{ordernumber},
395 author => $biblio->author,
396 title => $biblio->title,
397 publishercode => $biblioitem->publishercode,
398 publicationyear => $biblioitem->publicationyear,
399 collectiontitle => $biblioitem->collectiontitle,
400 isbn => $order->{isbn},
401 quantity => $order->{quantity},
402 rrp_tax_included => $order->{rrp_tax_included},
403 rrp_tax_excluded => $order->{rrp_tax_excluded},
404 discount => $bookseller->discount,
405 ecost_tax_included => $order->{ecost_tax_included},
406 ecost_tax_excluded => $order->{ecost_tax_excluded},
407 notes => $order->{order_vendornote},
408 entrydate => $order->{entrydate},
409 booksellername => $bookseller->name,
410 bookselleraddress => $bookseller->address1,
411 booksellerpostal => $bookseller->postal,
412 contractnumber => $contract->{contractnumber},
413 contractname => $contract->{contractname},
416 basketgroupdeliveryplace => $basketgroup->{deliveryplace},
417 basketgroupbillingplace => $basketgroup->{billingplace},
418 basketdeliveryplace => $basket->{deliveryplace},
419 basketbillingplace => $basket->{billingplace},
421 for my $place (qw( basketgroupdeliveryplace basketgroupbillingplace basketdeliveryplace basketbillingplace )) {
422 if ( my $library = Koha::Libraries->find( $temp->{$place} ) ) {
423 $row->{$place} = $library->branchname;
427 basketname author title publishercode collectiontitle notes
428 booksellername bookselleraddress booksellerpostal contractname
429 basketgroupdeliveryplace basketgroupbillingplace
430 basketdeliveryplace basketbillingplace
432 # Double the quotes to not be interpreted as a field end
433 $row->{$_} =~ s/"/""/g if $row->{$_};
438 $template->param(rows => \@rows);
440 return $template->output;
444 =head3 CloseBasketgroup
446 &CloseBasketgroup($basketgroupno);
452 sub CloseBasketgroup {
453 my ($basketgroupno) = @_;
454 my $dbh = C4::Context->dbh;
455 my $sth = $dbh->prepare("
456 UPDATE aqbasketgroups
460 $sth->execute($basketgroupno);
463 #------------------------------------------------------------#
465 =head3 ReOpenBaskergroup($basketgroupno)
467 &ReOpenBaskergroup($basketgroupno);
473 sub ReOpenBasketgroup {
474 my ($basketgroupno) = @_;
475 my $dbh = C4::Context->dbh;
476 my $sth = $dbh->prepare("
477 UPDATE aqbasketgroups
481 $sth->execute($basketgroupno);
484 #------------------------------------------------------------#
489 &DelBasket($basketno);
491 Deletes the basket that has basketno field $basketno in the aqbasket table.
495 =item C<$basketno> is the primary key of the basket in the aqbasket table.
502 my ( $basketno ) = @_;
503 my $query = "DELETE FROM aqbasket WHERE basketno=?";
504 my $dbh = C4::Context->dbh;
505 my $sth = $dbh->prepare($query);
506 $sth->execute($basketno);
510 #------------------------------------------------------------#
514 &ModBasket($basketinfo);
516 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
520 =item C<$basketno> is the primary key of the basket in the aqbasket table.
527 my $basketinfo = shift;
528 my $query = "UPDATE aqbasket SET ";
530 foreach my $key (keys %$basketinfo){
531 if ($key ne 'basketno'){
532 $query .= "$key=?, ";
533 push(@params, $basketinfo->{$key} || undef );
536 # get rid of the "," at the end of $query
537 if (substr($query, length($query)-2) eq ', '){
542 $query .= "WHERE basketno=?";
543 push(@params, $basketinfo->{'basketno'});
544 my $dbh = C4::Context->dbh;
545 my $sth = $dbh->prepare($query);
546 $sth->execute(@params);
551 #------------------------------------------------------------#
553 =head3 ModBasketHeader
555 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
557 Modifies a basket's header.
561 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
563 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
565 =item C<$note> is the "note" field in the "aqbasket" table;
567 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
569 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
571 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
573 =item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
575 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
577 =item C<$is_standing> is the "is_standing" field in the aqbasket table.
579 =item C<$create_items> should be set to 'ordering', 'receiving' or 'cataloguing' (or undef, in which
580 case the AcqCreateItem syspref takes precedence).
586 sub ModBasketHeader {
587 my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items) = @_;
592 SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=?, is_standing=?, create_items=?
596 my $dbh = C4::Context->dbh;
597 my $sth = $dbh->prepare($query);
598 $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items || undef, $basketno);
600 if ( $contractnumber ) {
601 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
602 my $sth2 = $dbh->prepare($query2);
603 $sth2->execute($contractnumber,$basketno);
608 #------------------------------------------------------------#
610 =head3 GetBasketsByBookseller
612 @results = &GetBasketsByBookseller($booksellerid, $extra);
614 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
618 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
620 =item C<$extra> is the extra sql parameters, can be
622 $extra->{groupby}: group baskets by column
623 ex. $extra->{groupby} = aqbasket.basketgroupid
624 $extra->{orderby}: order baskets by column
625 $extra->{limit}: limit number of results (can be helpful for pagination)
631 sub GetBasketsByBookseller {
632 my ($booksellerid, $extra) = @_;
633 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
635 if ($extra->{groupby}) {
636 $query .= " GROUP by $extra->{groupby}";
638 if ($extra->{orderby}){
639 $query .= " ORDER by $extra->{orderby}";
641 if ($extra->{limit}){
642 $query .= " LIMIT $extra->{limit}";
645 my $dbh = C4::Context->dbh;
646 my $sth = $dbh->prepare($query);
647 $sth->execute($booksellerid);
648 return $sth->fetchall_arrayref({});
651 =head3 GetBasketsInfosByBookseller
653 my $baskets = GetBasketsInfosByBookseller($supplierid, $allbaskets);
655 The optional second parameter allbaskets is a boolean allowing you to
656 select all baskets from the supplier; by default only active baskets (open or
657 closed but still something to receive) are returned.
659 Returns in a arrayref of hashref all about booksellers baskets, plus:
660 total_biblios: Number of distinct biblios in basket
661 total_items: Number of items in basket
662 expected_items: Number of non-received items in basket
666 sub GetBasketsInfosByBookseller {
667 my ($supplierid, $allbaskets) = @_;
669 return unless $supplierid;
671 my $dbh = C4::Context->dbh;
673 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,
674 SUM(aqorders.quantity) AS total_items,
676 IF ( aqorders.orderstatus = 'cancelled', aqorders.quantity, 0 )
677 ) AS total_items_cancelled,
678 COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
680 IF(aqorders.datereceived IS NULL
681 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
686 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
687 WHERE booksellerid = ?};
689 $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";
691 unless ( $allbaskets ) {
692 # Don't show the basket if it's NOT CLOSED or is FULLY RECEIVED
693 $query.=" HAVING (closedate IS NULL OR (
695 IF(aqorders.datereceived IS NULL
696 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
702 my $sth = $dbh->prepare($query);
703 $sth->execute($supplierid);
704 my $baskets = $sth->fetchall_arrayref({});
706 # Retrieve the number of biblios cancelled
707 my $cancelled_biblios = $dbh->selectall_hashref( q|
708 SELECT COUNT(DISTINCT(biblionumber)) AS total_biblios_cancelled, aqbasket.basketno
710 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
711 WHERE booksellerid = ?
712 AND aqorders.orderstatus = 'cancelled'
713 GROUP BY aqbasket.basketno
714 |, 'basketno', {}, $supplierid );
716 $_->{total_biblios_cancelled} = $cancelled_biblios->{$_->{basketno}}{total_biblios_cancelled} || 0
722 =head3 GetBasketUsers
724 $basketusers_ids = &GetBasketUsers($basketno);
726 Returns a list of all borrowernumbers that are in basket users list
731 my $basketno = shift;
733 return unless $basketno;
736 SELECT borrowernumber
740 my $dbh = C4::Context->dbh;
741 my $sth = $dbh->prepare($query);
742 $sth->execute($basketno);
743 my $results = $sth->fetchall_arrayref( {} );
746 foreach (@$results) {
747 push @borrowernumbers, $_->{'borrowernumber'};
750 return @borrowernumbers;
753 =head3 ModBasketUsers
755 my @basketusers_ids = (1, 2, 3);
756 &ModBasketUsers($basketno, @basketusers_ids);
758 Delete all users from basket users list, and add users in C<@basketusers_ids>
764 my ($basketno, @basketusers_ids) = @_;
766 return unless $basketno;
768 my $dbh = C4::Context->dbh;
770 DELETE FROM aqbasketusers
773 my $sth = $dbh->prepare($query);
774 $sth->execute($basketno);
777 INSERT INTO aqbasketusers (basketno, borrowernumber)
780 $sth = $dbh->prepare($query);
781 foreach my $basketuser_id (@basketusers_ids) {
782 $sth->execute($basketno, $basketuser_id);
787 =head3 CanUserManageBasket
789 my $bool = CanUserManageBasket($borrower, $basket[, $userflags]);
790 my $bool = CanUserManageBasket($borrowernumber, $basketno[, $userflags]);
792 Check if a borrower can manage a basket, according to system preference
793 AcqViewBaskets, user permissions and basket properties (creator, users list,
796 First parameter can be either a borrowernumber or a hashref as returned by
797 Koha::Patron->unblessed
799 Second parameter can be either a basketno or a hashref as returned by
800 C4::Acquisition::GetBasket.
802 The third parameter is optional. If given, it should be a hashref as returned
803 by C4::Auth::getuserflags. If not, getuserflags is called.
805 If user is authorised to manage basket, returns 1.
810 sub CanUserManageBasket {
811 my ($borrower, $basket, $userflags) = @_;
813 if (!ref $borrower) {
814 # FIXME This needs to be replaced
815 # We should not accept both scalar and array
816 # Tests need to be updated
817 $borrower = Koha::Patrons->find( $borrower )->unblessed;
820 $basket = GetBasket($basket);
823 return 0 unless ($basket and $borrower);
825 my $borrowernumber = $borrower->{borrowernumber};
826 my $basketno = $basket->{basketno};
828 my $AcqViewBaskets = C4::Context->preference('AcqViewBaskets');
830 if (!defined $userflags) {
831 my $dbh = C4::Context->dbh;
832 my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE borrowernumber = ?");
833 $sth->execute($borrowernumber);
834 my ($flags) = $sth->fetchrow_array;
837 $userflags = C4::Auth::getuserflags($flags, $borrower->{userid}, $dbh);
840 unless ($userflags->{superlibrarian}
841 || (ref $userflags->{acquisition} && $userflags->{acquisition}->{order_manage_all})
842 || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
844 if (not exists $userflags->{acquisition}) {
848 if ( (ref $userflags->{acquisition} && !$userflags->{acquisition}->{order_manage})
849 || (!ref $userflags->{acquisition} && !$userflags->{acquisition}) ) {
853 if ($AcqViewBaskets eq 'user'
854 && $basket->{authorisedby} != $borrowernumber
855 && ! grep { $borrowernumber eq $_ } GetBasketUsers($basketno)) {
859 if ($AcqViewBaskets eq 'branch' && defined $basket->{branch}
860 && $basket->{branch} ne $borrower->{branchcode}) {
868 #------------------------------------------------------------#
870 =head3 GetBasketsByBasketgroup
872 $baskets = &GetBasketsByBasketgroup($basketgroupid);
874 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
878 sub GetBasketsByBasketgroup {
879 my $basketgroupid = shift;
881 SELECT *, aqbasket.booksellerid as booksellerid
883 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?
885 my $dbh = C4::Context->dbh;
886 my $sth = $dbh->prepare($query);
887 $sth->execute($basketgroupid);
888 return $sth->fetchall_arrayref({});
891 #------------------------------------------------------------#
893 =head3 NewBasketgroup
895 $basketgroupid = NewBasketgroup(\%hashref);
897 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
899 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
901 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
903 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
905 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
907 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
909 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
911 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
913 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
918 my $basketgroupinfo = shift;
919 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
920 my $query = "INSERT INTO aqbasketgroups (";
922 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
923 if ( defined $basketgroupinfo->{$field} ) {
924 $query .= "$field, ";
925 push(@params, $basketgroupinfo->{$field});
928 $query .= "booksellerid) VALUES (";
933 push(@params, $basketgroupinfo->{'booksellerid'});
934 my $dbh = C4::Context->dbh;
935 my $sth = $dbh->prepare($query);
936 $sth->execute(@params);
937 my $basketgroupid = $dbh->{'mysql_insertid'};
938 if( $basketgroupinfo->{'basketlist'} ) {
939 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
940 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
941 my $sth2 = $dbh->prepare($query2);
942 $sth2->execute($basketgroupid, $basketno);
945 return $basketgroupid;
948 #------------------------------------------------------------#
950 =head3 ModBasketgroup
952 ModBasketgroup(\%hashref);
954 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
956 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
958 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
960 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
962 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
964 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
966 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
968 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
970 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
975 my $basketgroupinfo = shift;
976 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
977 my $dbh = C4::Context->dbh;
978 my $query = "UPDATE aqbasketgroups SET ";
980 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
981 if ( defined $basketgroupinfo->{$field} ) {
982 $query .= "$field=?, ";
983 push(@params, $basketgroupinfo->{$field});
988 $query .= " WHERE id=?";
989 push(@params, $basketgroupinfo->{'id'});
990 my $sth = $dbh->prepare($query);
991 $sth->execute(@params);
993 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
994 $sth->execute($basketgroupinfo->{'id'});
996 if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
997 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
998 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
999 $sth->execute($basketgroupinfo->{'id'}, $basketno);
1005 #------------------------------------------------------------#
1007 =head3 DelBasketgroup
1009 DelBasketgroup($basketgroupid);
1011 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
1015 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
1021 sub DelBasketgroup {
1022 my $basketgroupid = shift;
1023 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1024 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
1025 my $dbh = C4::Context->dbh;
1026 my $sth = $dbh->prepare($query);
1027 $sth->execute($basketgroupid);
1031 #------------------------------------------------------------#
1034 =head2 FUNCTIONS ABOUT ORDERS
1036 =head3 GetBasketgroup
1038 $basketgroup = &GetBasketgroup($basketgroupid);
1040 Returns a reference to the hash containing all information about the basketgroup.
1044 sub GetBasketgroup {
1045 my $basketgroupid = shift;
1046 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1047 my $dbh = C4::Context->dbh;
1048 my $result_set = $dbh->selectall_arrayref(
1049 'SELECT * FROM aqbasketgroups WHERE id=?',
1053 return $result_set->[0]; # id is unique
1056 #------------------------------------------------------------#
1058 =head3 GetBasketgroups
1060 $basketgroups = &GetBasketgroups($booksellerid);
1062 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
1066 sub GetBasketgroups {
1067 my $booksellerid = shift;
1068 die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
1069 my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
1070 my $dbh = C4::Context->dbh;
1071 my $sth = $dbh->prepare($query);
1072 $sth->execute($booksellerid);
1073 return $sth->fetchall_arrayref({});
1076 #------------------------------------------------------------#
1078 =head2 FUNCTIONS ABOUT ORDERS
1082 @orders = &GetOrders( $basketno, { orderby => 'biblio.title', cancelled => 0|1 } );
1084 Looks up the pending (non-cancelled) orders with the given basket
1087 If cancelled is set, only cancelled orders will be returned.
1092 my ( $basketno, $params ) = @_;
1094 return () unless $basketno;
1096 my $orderby = $params->{orderby};
1097 my $cancelled = $params->{cancelled} || 0;
1099 my $dbh = C4::Context->dbh;
1101 SELECT biblio.*,biblioitems.*,
1105 $query .= $cancelled
1107 aqorders_transfers.ordernumber_to AS transferred_to,
1108 aqorders_transfers.timestamp AS transferred_to_timestamp
1111 aqorders_transfers.ordernumber_from AS transferred_from,
1112 aqorders_transfers.timestamp AS transferred_from_timestamp
1116 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1117 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1118 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1120 $query .= $cancelled
1122 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
1125 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1133 $orderby ||= q|biblioitems.publishercode, biblio.title|;
1135 AND (datecancellationprinted IS NOT NULL
1136 AND datecancellationprinted <> '0000-00-00')
1141 q|aqorders.datecancellationprinted desc, aqorders.timestamp desc|;
1143 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
1147 $query .= " ORDER BY $orderby";
1149 $dbh->selectall_arrayref( $query, { Slice => {} }, $basketno );
1154 #------------------------------------------------------------#
1156 =head3 GetOrdersByBiblionumber
1158 @orders = &GetOrdersByBiblionumber($biblionumber);
1160 Looks up the orders with linked to a specific $biblionumber, including
1161 cancelled orders and received orders.
1164 C<@orders> is an array of references-to-hash, whose keys are the
1165 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
1169 sub GetOrdersByBiblionumber {
1170 my $biblionumber = shift;
1171 return unless $biblionumber;
1172 my $dbh = C4::Context->dbh;
1174 SELECT biblio.*,biblioitems.*,
1178 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1179 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1180 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1181 WHERE aqorders.biblionumber=?
1184 $dbh->selectall_arrayref( $query, { Slice => {} }, $biblionumber );
1185 return @{$result_set};
1189 #------------------------------------------------------------#
1193 $order = &GetOrder($ordernumber);
1195 Looks up an order by order number.
1197 Returns a reference-to-hash describing the order. The keys of
1198 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1203 my ($ordernumber) = @_;
1204 return unless $ordernumber;
1206 my $dbh = C4::Context->dbh;
1207 my $query = qq{SELECT
1211 aqbasket.basketname,
1212 borrowers.branchcode,
1213 biblioitems.publicationyear,
1214 biblio.copyrightdate,
1215 biblioitems.editionstatement,
1219 biblioitems.publishercode,
1220 aqorders.rrp AS unitpricesupplier,
1221 aqorders.ecost AS unitpricelib,
1222 aqorders.claims_count AS claims_count,
1223 aqorders.claimed_date AS claimed_date,
1224 aqbudgets.budget_name AS budget,
1225 aqbooksellers.name AS supplier,
1226 aqbooksellers.id AS supplierid,
1227 biblioitems.publishercode AS publisher,
1228 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1229 DATE(aqbasket.closedate) AS orderdate,
1230 aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity_to_receive,
1231 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1232 DATEDIFF(CURDATE( ),closedate) AS latesince
1233 FROM aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1234 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1235 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1236 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
1237 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1238 WHERE aqorders.basketno = aqbasket.basketno
1241 $dbh->selectall_arrayref( $query, { Slice => {} }, $ordernumber );
1243 # result_set assumed to contain 1 match
1244 return $result_set->[0];
1247 =head3 GetLastOrderNotReceivedFromSubscriptionid
1249 $order = &GetLastOrderNotReceivedFromSubscriptionid($subscriptionid);
1251 Returns a reference-to-hash describing the last order not received for a subscription.
1255 sub GetLastOrderNotReceivedFromSubscriptionid {
1256 my ( $subscriptionid ) = @_;
1257 my $dbh = C4::Context->dbh;
1259 SELECT * FROM aqorders
1260 LEFT JOIN subscription
1261 ON ( aqorders.subscriptionid = subscription.subscriptionid )
1262 WHERE aqorders.subscriptionid = ?
1263 AND aqorders.datereceived IS NULL
1267 $dbh->selectall_arrayref( $query, { Slice => {} }, $subscriptionid );
1269 # result_set assumed to contain 1 match
1270 return $result_set->[0];
1273 =head3 GetLastOrderReceivedFromSubscriptionid
1275 $order = &GetLastOrderReceivedFromSubscriptionid($subscriptionid);
1277 Returns a reference-to-hash describing the last order received for a subscription.
1281 sub GetLastOrderReceivedFromSubscriptionid {
1282 my ( $subscriptionid ) = @_;
1283 my $dbh = C4::Context->dbh;
1285 SELECT * FROM aqorders
1286 LEFT JOIN subscription
1287 ON ( aqorders.subscriptionid = subscription.subscriptionid )
1288 WHERE aqorders.subscriptionid = ?
1289 AND aqorders.datereceived =
1291 SELECT MAX( aqorders.datereceived )
1293 LEFT JOIN subscription
1294 ON ( aqorders.subscriptionid = subscription.subscriptionid )
1295 WHERE aqorders.subscriptionid = ?
1296 AND aqorders.datereceived IS NOT NULL
1298 ORDER BY ordernumber DESC
1302 $dbh->selectall_arrayref( $query, { Slice => {} }, $subscriptionid, $subscriptionid );
1304 # result_set assumed to contain 1 match
1305 return $result_set->[0];
1309 #------------------------------------------------------------#
1313 &ModOrder(\%hashref);
1315 Modifies an existing order. Updates the order with order number
1316 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1317 other keys of the hash update the fields with the same name in the aqorders
1318 table of the Koha database.
1323 my $orderinfo = shift;
1325 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '';
1327 my $dbh = C4::Context->dbh;
1330 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1331 $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1333 # delete($orderinfo->{'branchcode'});
1334 # the hash contains a lot of entries not in aqorders, so get the columns ...
1335 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1337 my $colnames = $sth->{NAME};
1338 #FIXME Be careful. If aqorders would have columns with diacritics,
1339 #you should need to decode what you get back from NAME.
1340 #See report 10110 and guided_reports.pl
1341 my $query = "UPDATE aqorders SET ";
1343 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1344 # ... and skip hash entries that are not in the aqorders table
1345 # FIXME : probably not the best way to do it (would be better to have a correct hash)
1346 next unless grep(/^$orderinfokey$/, @$colnames);
1347 $query .= "$orderinfokey=?, ";
1348 push(@params, $orderinfo->{$orderinfokey});
1351 $query .= "timestamp=NOW() WHERE ordernumber=?";
1352 push(@params, $orderinfo->{'ordernumber'} );
1353 $sth = $dbh->prepare($query);
1354 $sth->execute(@params);
1358 #------------------------------------------------------------#
1362 ModItemOrder($itemnumber, $ordernumber);
1364 Modifies the ordernumber of an item in aqorders_items.
1369 my ($itemnumber, $ordernumber) = @_;
1371 return unless ($itemnumber and $ordernumber);
1373 my $dbh = C4::Context->dbh;
1375 UPDATE aqorders_items
1377 WHERE itemnumber = ?
1379 my $sth = $dbh->prepare($query);
1380 return $sth->execute($ordernumber, $itemnumber);
1383 #------------------------------------------------------------#
1385 =head3 ModReceiveOrder
1387 my ( $date_received, $new_ordernumber ) = ModReceiveOrder(
1389 biblionumber => $biblionumber,
1391 quantityreceived => $quantityreceived,
1393 invoice => $invoice,
1394 budget_id => $budget_id,
1395 received_itemnumbers => \@received_itemnumbers,
1396 order_internalnote => $order_internalnote,
1400 Updates an order, to reflect the fact that it was received, at least
1403 If a partial order is received, splits the order into two.
1405 Updates the order with biblionumber C<$biblionumber> and ordernumber
1406 C<$order->{ordernumber}>.
1411 sub ModReceiveOrder {
1413 my $biblionumber = $params->{biblionumber};
1414 my $order = { %{ $params->{order} } }; # Copy the order, we don't want to modify it
1415 my $invoice = $params->{invoice};
1416 my $quantrec = $params->{quantityreceived};
1417 my $user = $params->{user};
1418 my $budget_id = $params->{budget_id};
1419 my $received_items = $params->{received_items};
1421 my $dbh = C4::Context->dbh;
1422 my $datereceived = ( $invoice and $invoice->{datereceived} ) ? $invoice->{datereceived} : dt_from_string;
1423 my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1424 if ($suggestionid) {
1425 ModSuggestion( {suggestionid=>$suggestionid,
1426 STATUS=>'AVAILABLE',
1427 biblionumber=> $biblionumber}
1431 my $result_set = $dbh->selectrow_arrayref(
1432 q{SELECT aqbasket.is_standing
1434 WHERE basketno=?},{ Slice => {} }, $order->{basketno});
1435 my $is_standing = $result_set->[0]; # we assume we have a unique basket
1437 my $new_ordernumber = $order->{ordernumber};
1438 if ( $is_standing || $order->{quantity} > $quantrec ) {
1439 # Split order line in two parts: the first is the original order line
1440 # without received items (the quantity is decreased),
1441 # the second part is a new order line with quantity=quantityrec
1442 # (entirely received)
1446 orderstatus = 'partial'|;
1447 $query .= q| WHERE ordernumber = ?|;
1448 my $sth = $dbh->prepare($query);
1451 ( $is_standing ? 1 : ($order->{quantity} - $quantrec) ),
1452 $order->{ordernumber}
1455 if ( not $order->{subscriptionid} && defined $order->{order_internalnote} ) {
1456 $dbh->do(q|UPDATE aqorders
1457 SET order_internalnote = ?|, {}, $order->{order_internalnote});
1460 # Recalculate tax_value
1464 tax_value_on_ordering = quantity * ecost_tax_excluded * tax_rate_on_ordering,
1465 tax_value_on_receiving = quantity * unitprice_tax_excluded * tax_rate_on_receiving
1466 WHERE ordernumber = ?
1467 |, undef, $order->{ordernumber});
1469 delete $order->{ordernumber};
1470 $order->{budget_id} = ( $budget_id || $order->{budget_id} );
1471 $order->{quantity} = $quantrec;
1472 $order->{quantityreceived} = $quantrec;
1473 $order->{ecost_tax_excluded} //= 0;
1474 $order->{tax_rate_on_ordering} //= 0;
1475 $order->{unitprice_tax_excluded} //= 0;
1476 $order->{tax_rate_on_receiving} //= 0;
1477 $order->{tax_value_on_ordering} = $order->{quantity} * $order->{ecost_tax_excluded} * $order->{tax_rate_on_ordering};
1478 $order->{tax_value_on_receiving} = $order->{quantity} * $order->{unitprice_tax_excluded} * $order->{tax_rate_on_receiving};
1479 $order->{datereceived} = $datereceived;
1480 $order->{invoiceid} = $invoice->{invoiceid};
1481 $order->{orderstatus} = 'complete';
1482 $new_ordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber; # TODO What if the store fails?
1484 if ($received_items) {
1485 foreach my $itemnumber (@$received_items) {
1486 ModItemOrder($itemnumber, $new_ordernumber);
1492 SET quantityreceived = ?,
1496 orderstatus = 'complete'
1500 , replacementprice = ?
1501 | if defined $order->{replacementprice};
1504 , unitprice = ?, unitprice_tax_included = ?, unitprice_tax_excluded = ?
1505 | if defined $order->{unitprice};
1508 ,tax_value_on_receiving = ?
1509 | if defined $order->{tax_value_on_receiving};
1512 ,tax_rate_on_receiving = ?
1513 | if defined $order->{tax_rate_on_receiving};
1516 , order_internalnote = ?
1517 | if defined $order->{order_internalnote};
1519 $query .= q| where biblionumber=? and ordernumber=?|;
1521 my $sth = $dbh->prepare( $query );
1522 my @params = ( $quantrec, $datereceived, $invoice->{invoiceid}, ( $budget_id ? $budget_id : $order->{budget_id} ) );
1524 if ( defined $order->{replacementprice} ) {
1525 push @params, $order->{replacementprice};
1528 if ( defined $order->{unitprice} ) {
1529 push @params, $order->{unitprice}, $order->{unitprice_tax_included}, $order->{unitprice_tax_excluded};
1532 if ( defined $order->{tax_value_on_receiving} ) {
1533 push @params, $order->{tax_value_on_receiving};
1536 if ( defined $order->{tax_rate_on_receiving} ) {
1537 push @params, $order->{tax_rate_on_receiving};
1540 if ( defined $order->{order_internalnote} ) {
1541 push @params, $order->{order_internalnote};
1544 push @params, ( $biblionumber, $order->{ordernumber} );
1546 $sth->execute( @params );
1548 # All items have been received, sent a notification to users
1549 NotifyOrderUsers( $order->{ordernumber} );
1552 return ($datereceived, $new_ordernumber);
1555 =head3 CancelReceipt
1557 my $parent_ordernumber = CancelReceipt($ordernumber);
1559 Cancel an order line receipt and update the parent order line, as if no
1561 If items are created at receipt (AcqCreateItem = receiving) then delete
1567 my $ordernumber = shift;
1569 return unless $ordernumber;
1571 my $dbh = C4::Context->dbh;
1573 SELECT datereceived, parent_ordernumber, quantity
1575 WHERE ordernumber = ?
1577 my $sth = $dbh->prepare($query);
1578 $sth->execute($ordernumber);
1579 my $order = $sth->fetchrow_hashref;
1581 warn "CancelReceipt: order $ordernumber does not exist";
1584 unless($order->{'datereceived'}) {
1585 warn "CancelReceipt: order $ordernumber is not received";
1589 my $parent_ordernumber = $order->{'parent_ordernumber'};
1591 my $order_obj = Koha::Acquisition::Orders->find( $ordernumber ); # FIXME rewrite all this subroutine using this object
1592 my @itemnumbers = $order_obj->items->get_column('itemnumber');
1594 if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1595 # The order line has no parent, just mark it as not received
1598 SET quantityreceived = ?,
1601 orderstatus = 'ordered'
1602 WHERE ordernumber = ?
1604 $sth = $dbh->prepare($query);
1605 $sth->execute(0, undef, undef, $ordernumber);
1606 _cancel_items_receipt( $order_obj );
1608 # The order line has a parent, increase parent quantity and delete
1611 SELECT quantity, datereceived
1613 WHERE ordernumber = ?
1615 $sth = $dbh->prepare($query);
1616 $sth->execute($parent_ordernumber);
1617 my $parent_order = $sth->fetchrow_hashref;
1618 unless($parent_order) {
1619 warn "Parent order $parent_ordernumber does not exist.";
1622 if($parent_order->{'datereceived'}) {
1623 warn "CancelReceipt: parent order is received.".
1624 " Can't cancel receipt.";
1630 orderstatus = 'ordered'
1631 WHERE ordernumber = ?
1633 $sth = $dbh->prepare($query);
1634 my $rv = $sth->execute(
1635 $order->{'quantity'} + $parent_order->{'quantity'},
1639 warn "Cannot update parent order line, so do not cancel".
1644 # Recalculate tax_value
1648 tax_value_on_ordering = quantity * ecost_tax_excluded * tax_rate_on_ordering,
1649 tax_value_on_receiving = quantity * unitprice_tax_excluded * tax_rate_on_receiving
1650 WHERE ordernumber = ?
1651 |, undef, $parent_ordernumber);
1653 _cancel_items_receipt( $order_obj, $parent_ordernumber );
1656 DELETE FROM aqorders
1657 WHERE ordernumber = ?
1659 $sth = $dbh->prepare($query);
1660 $sth->execute($ordernumber);
1664 if( $order_obj->basket->effective_create_items eq 'ordering' ) {
1665 my @affects = split q{\|}, C4::Context->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1667 for my $in ( @itemnumbers ) {
1668 my $item = Koha::Items->find( $in ); # FIXME We do not need that, we already have Koha::Items from $order_obj->items
1669 my $biblio = $item->biblio;
1670 my ( $itemfield ) = GetMarcFromKohaField( 'items.itemnumber', $biblio->frameworkcode );
1671 my $item_marc = C4::Items::GetMarcItem( $biblio->biblionumber, $in );
1672 for my $affect ( @affects ) {
1673 my ( $sf, $v ) = split q{=}, $affect, 2;
1674 foreach ( $item_marc->field($itemfield) ) {
1675 $_->update( $sf => $v );
1678 C4::Items::ModItemFromMarc( $item_marc, $biblio->biblionumber, $in );
1683 return $parent_ordernumber;
1686 sub _cancel_items_receipt {
1687 my ( $order, $parent_ordernumber ) = @_;
1688 $parent_ordernumber ||= $order->ordernumber;
1690 my $items = $order->items;
1691 if ( $order->basket->effective_create_items eq 'receiving' ) {
1692 # Remove items that were created at receipt
1694 DELETE FROM items, aqorders_items
1695 USING items, aqorders_items
1696 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1698 my $dbh = C4::Context->dbh;
1699 my $sth = $dbh->prepare($query);
1700 while ( my $item = $items->next ) {
1701 $sth->execute($item->itemnumber, $item->itemnumber);
1705 while ( my $item = $items->next ) {
1706 ModItemOrder($item->itemnumber, $parent_ordernumber);
1711 #------------------------------------------------------------#
1715 @results = &SearchOrders({
1716 ordernumber => $ordernumber,
1719 booksellerid => $booksellerid,
1720 basketno => $basketno,
1721 basketname => $basketname,
1722 basketgroupname => $basketgroupname,
1726 biblionumber => $biblionumber,
1727 budget_id => $budget_id
1730 Searches for orders filtered by criteria.
1732 C<$ordernumber> Finds matching orders or transferred orders by ordernumber.
1733 C<$search> Finds orders matching %$search% in title, author, or isbn.
1734 C<$owner> Finds order for the logged in user.
1735 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1736 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1739 C<@results> is an array of references-to-hash with the keys are fields
1740 from aqorders, biblio, biblioitems and aqbasket tables.
1745 my ( $params ) = @_;
1746 my $ordernumber = $params->{ordernumber};
1747 my $search = $params->{search};
1748 my $ean = $params->{ean};
1749 my $booksellerid = $params->{booksellerid};
1750 my $basketno = $params->{basketno};
1751 my $basketname = $params->{basketname};
1752 my $basketgroupname = $params->{basketgroupname};
1753 my $owner = $params->{owner};
1754 my $pending = $params->{pending};
1755 my $ordered = $params->{ordered};
1756 my $biblionumber = $params->{biblionumber};
1757 my $budget_id = $params->{budget_id};
1759 my $dbh = C4::Context->dbh;
1762 SELECT aqbasket.basketno,
1764 borrowers.firstname,
1767 biblioitems.biblioitemnumber,
1768 biblioitems.publishercode,
1769 biblioitems.publicationyear,
1770 aqbasket.authorisedby,
1771 aqbasket.booksellerid,
1773 aqbasket.creationdate,
1774 aqbasket.basketname,
1775 aqbasketgroups.id as basketgroupid,
1776 aqbasketgroups.name as basketgroupname,
1779 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1780 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1781 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1782 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1783 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1786 # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
1788 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1792 WHERE (datecancellationprinted is NULL)
1795 if ( $pending or $ordered ) {
1798 ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) )
1800 ( quantity > quantityreceived OR quantityreceived is NULL )
1804 $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1812 my $userenv = C4::Context->userenv;
1813 if ( C4::Context->preference("IndependentBranches") ) {
1814 unless ( C4::Context->IsSuperLibrarian() ) {
1817 borrowers.branchcode = ?
1818 OR borrowers.branchcode = ''
1821 push @args, $userenv->{branch};
1825 if ( $ordernumber ) {
1826 $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1827 push @args, ( $ordernumber, $ordernumber );
1829 if ( $biblionumber ) {
1830 $query .= 'AND aqorders.biblionumber = ?';
1831 push @args, $biblionumber;
1834 $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1835 push @args, ("%$search%","%$search%","%$search%");
1838 $query .= ' AND biblioitems.ean = ?';
1841 if ( $booksellerid ) {
1842 $query .= 'AND aqbasket.booksellerid = ?';
1843 push @args, $booksellerid;
1846 $query .= 'AND aqbasket.basketno = ?';
1847 push @args, $basketno;
1850 $query .= 'AND aqbasket.basketname LIKE ?';
1851 push @args, "%$basketname%";
1853 if( $basketgroupname ) {
1854 $query .= ' AND aqbasketgroups.name LIKE ?';
1855 push @args, "%$basketgroupname%";
1859 $query .= ' AND aqbasket.authorisedby=? ';
1860 push @args, $userenv->{'number'};
1864 $query .= ' AND aqorders.budget_id = ?';
1865 push @args, $budget_id;
1868 $query .= ' ORDER BY aqbasket.basketno';
1870 my $sth = $dbh->prepare($query);
1871 $sth->execute(@args);
1872 return $sth->fetchall_arrayref({});
1875 #------------------------------------------------------------#
1879 &DelOrder($biblionumber, $ordernumber);
1881 Cancel the order with the given order and biblio numbers. It does not
1882 delete any entries in the aqorders table, it merely marks them as
1888 my ( $bibnum, $ordernumber, $delete_biblio, $reason ) = @_;
1891 my $dbh = C4::Context->dbh;
1894 SET datecancellationprinted=now(), orderstatus='cancelled'
1897 $query .= ", cancellationreason = ? ";
1900 WHERE biblionumber=? AND ordernumber=?
1902 my $sth = $dbh->prepare($query);
1904 $sth->execute($reason, $bibnum, $ordernumber);
1906 $sth->execute( $bibnum, $ordernumber );
1910 my $order = Koha::Acquisition::Orders->find($ordernumber);
1911 my $items = $order->items;
1912 while ( my $item = $items->next ) { # Should be moved to Koha::Acquisition::Order->delete
1913 my $delcheck = C4::Items::DelItemCheck( $bibnum, $item->itemnumber );
1915 if($delcheck != 1) {
1916 $error->{'delitem'} = 1;
1920 if($delete_biblio) {
1921 # We get the number of remaining items
1922 my $biblio = Koha::Biblios->find( $bibnum );
1923 my $itemcount = $biblio->items->count;
1925 # If there are no items left,
1926 if ( $itemcount == 0 ) {
1927 # We delete the record
1928 my $delcheck = DelBiblio($bibnum);
1931 $error->{'delbiblio'} = 1;
1939 =head3 TransferOrder
1941 my $newordernumber = TransferOrder($ordernumber, $basketno);
1943 Transfer an order line to a basket.
1944 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1945 to BOOKSELLER on DATE' and create new order with internal note
1946 'Transferred from BOOKSELLER on DATE'.
1947 Move all attached items to the new order.
1948 Received orders cannot be transferred.
1949 Return the ordernumber of created order.
1954 my ($ordernumber, $basketno) = @_;
1956 return unless ($ordernumber and $basketno);
1958 my $order = Koha::Acquisition::Orders->find( $ordernumber ) or return;
1959 return if $order->datereceived;
1961 $order = $order->unblessed;
1963 my $basket = GetBasket($basketno);
1964 return unless $basket;
1966 my $dbh = C4::Context->dbh;
1967 my ($query, $sth, $rv);
1971 SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1972 WHERE ordernumber = ?
1974 $sth = $dbh->prepare($query);
1975 $rv = $sth->execute('cancelled', $ordernumber);
1977 delete $order->{'ordernumber'};
1978 delete $order->{parent_ordernumber};
1979 $order->{'basketno'} = $basketno;
1981 my $newordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber;
1984 UPDATE aqorders_items
1986 WHERE ordernumber = ?
1988 $sth = $dbh->prepare($query);
1989 $sth->execute($newordernumber, $ordernumber);
1992 INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1995 $sth = $dbh->prepare($query);
1996 $sth->execute($ordernumber, $newordernumber);
1998 return $newordernumber;
2001 =head2 FUNCTIONS ABOUT PARCELS
2005 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
2007 get a lists of parcels.
2014 is the bookseller this function has to get parcels.
2017 To know on what criteria the results list has to be ordered.
2020 is the booksellerinvoicenumber.
2022 =item $datefrom & $dateto
2023 to know on what date this function has to filter its search.
2028 a pointer on a hash list containing parcel informations as such :
2034 =item Last operation
2036 =item Number of biblio
2038 =item Number of items
2045 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
2046 my $dbh = C4::Context->dbh;
2047 my @query_params = ();
2049 SELECT aqinvoices.invoicenumber,
2050 datereceived,purchaseordernumber,
2051 count(DISTINCT biblionumber) AS biblio,
2052 sum(quantity) AS itemsexpected,
2053 sum(quantityreceived) AS itemsreceived
2054 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
2055 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2056 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
2058 push @query_params, $bookseller;
2060 if ( defined $code ) {
2061 $strsth .= ' and aqinvoices.invoicenumber like ? ';
2062 # add a % to the end of the code to allow stemming.
2063 push @query_params, "$code%";
2066 if ( defined $datefrom ) {
2067 $strsth .= ' and datereceived >= ? ';
2068 push @query_params, $datefrom;
2071 if ( defined $dateto ) {
2072 $strsth .= 'and datereceived <= ? ';
2073 push @query_params, $dateto;
2076 $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
2078 # can't use a placeholder to place this column name.
2079 # but, we could probably be checking to make sure it is a column that will be fetched.
2080 $strsth .= "order by $order " if ($order);
2082 my $sth = $dbh->prepare($strsth);
2084 $sth->execute( @query_params );
2085 my $results = $sth->fetchall_arrayref({});
2089 #------------------------------------------------------------#
2091 =head3 GetLateOrders
2093 @results = &GetLateOrders;
2095 Searches for bookseller with late orders.
2098 the table of supplier with late issues. This table is full of hashref.
2104 my $supplierid = shift;
2106 my $estimateddeliverydatefrom = shift;
2107 my $estimateddeliverydateto = shift;
2109 my $dbh = C4::Context->dbh;
2111 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
2112 my $dbdriver = C4::Context->config("db_scheme") || "mysql";
2114 my @query_params = ();
2116 SELECT aqbasket.basketno,
2117 aqorders.ordernumber,
2118 DATE(aqbasket.closedate) AS orderdate,
2119 aqbasket.basketname AS basketname,
2120 aqbasket.basketgroupid AS basketgroupid,
2121 aqbasketgroups.name AS basketgroupname,
2122 aqorders.rrp AS unitpricesupplier,
2123 aqorders.ecost AS unitpricelib,
2124 aqorders.claims_count AS claims_count,
2125 aqorders.claimed_date AS claimed_date,
2126 aqbudgets.budget_name AS budget,
2127 borrowers.branchcode AS branch,
2128 aqbooksellers.name AS supplier,
2129 aqbooksellers.id AS supplierid,
2130 biblio.author, biblio.title,
2131 biblioitems.publishercode AS publisher,
2132 biblioitems.publicationyear,
2133 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
2137 aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
2138 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
2139 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
2140 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
2141 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
2142 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2143 WHERE aqorders.basketno = aqbasket.basketno
2144 AND ( datereceived = ''
2145 OR datereceived IS NULL
2146 OR aqorders.quantityreceived < aqorders.quantity
2148 AND aqbasket.closedate IS NOT NULL
2149 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
2151 if ($dbdriver eq "mysql") {
2153 aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity,
2154 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
2155 DATEDIFF(CAST(now() AS date),closedate) AS latesince
2157 if ( defined $delay ) {
2158 $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
2159 push @query_params, $delay;
2161 $from .= " AND aqorders.quantity - COALESCE(aqorders.quantityreceived,0) <> 0";
2163 # FIXME: account for IFNULL as above
2165 aqorders.quantity AS quantity,
2166 aqorders.quantity * aqorders.rrp AS subtotal,
2167 (CAST(now() AS date) - closedate) AS latesince
2169 if ( defined $delay ) {
2170 $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
2171 push @query_params, $delay;
2173 $from .= " AND aqorders.quantity <> 0";
2175 if (defined $supplierid) {
2176 $from .= ' AND aqbasket.booksellerid = ? ';
2177 push @query_params, $supplierid;
2179 if (defined $branch) {
2180 $from .= ' AND borrowers.branchcode LIKE ? ';
2181 push @query_params, $branch;
2184 if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
2185 $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
2187 if ( defined $estimateddeliverydatefrom ) {
2188 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
2189 push @query_params, $estimateddeliverydatefrom;
2191 if ( defined $estimateddeliverydateto ) {
2192 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
2193 push @query_params, $estimateddeliverydateto;
2195 if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
2196 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
2198 if (C4::Context->preference("IndependentBranches")
2199 && !C4::Context->IsSuperLibrarian() ) {
2200 $from .= ' AND borrowers.branchcode LIKE ? ';
2201 push @query_params, C4::Context->userenv->{branch};
2203 $from .= " AND orderstatus <> 'cancelled' ";
2204 my $query = "$select $from \nORDER BY latesince, basketno, borrowers.branchcode, supplier";
2205 $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
2206 my $sth = $dbh->prepare($query);
2207 $sth->execute(@query_params);
2209 while (my $data = $sth->fetchrow_hashref) {
2210 push @results, $data;
2215 #------------------------------------------------------------#
2219 \@order_loop = GetHistory( %params );
2221 Retreives some acquisition history information
2231 basket - search both basket name and number
2232 booksellerinvoicenumber
2235 orderstatus (note that orderstatus '' will retrieve orders
2236 of any status except cancelled)
2238 get_canceled_order (if set to a true value, cancelled orders will
2242 $order_loop is a list of hashrefs that each look like this:
2244 'author' => 'Twain, Mark',
2246 'biblionumber' => '215',
2248 'creationdate' => 'MM/DD/YYYY',
2249 'datereceived' => undef,
2252 'invoicenumber' => undef,
2254 'ordernumber' => '1',
2256 'quantityreceived' => undef,
2257 'title' => 'The Adventures of Huckleberry Finn'
2263 # don't run the query if there are no parameters (list would be too long for sure !)
2264 croak "No search params" unless @_;
2266 my $title = $params{title};
2267 my $author = $params{author};
2268 my $isbn = $params{isbn};
2269 my $ean = $params{ean};
2270 my $name = $params{name};
2271 my $from_placed_on = $params{from_placed_on};
2272 my $to_placed_on = $params{to_placed_on};
2273 my $basket = $params{basket};
2274 my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2275 my $basketgroupname = $params{basketgroupname};
2276 my $budget = $params{budget};
2277 my $orderstatus = $params{orderstatus};
2278 my $biblionumber = $params{biblionumber};
2279 my $get_canceled_order = $params{get_canceled_order} || 0;
2280 my $ordernumber = $params{ordernumber};
2281 my $search_children_too = $params{search_children_too} || 0;
2282 my $created_by = $params{created_by} || [];
2283 my $ordernumbers = $params{ordernumbers} || [];
2284 my $additional_fields = $params{additional_fields} // [];
2288 my $total_qtyreceived = 0;
2289 my $total_price = 0;
2291 #get variation of isbn
2295 if ( C4::Context->preference("SearchWithISBNVariations") ){
2296 @isbns = C4::Koha::GetVariationsOfISBN( $isbn );
2297 foreach my $isb (@isbns){
2298 push @isbn_params, '?';
2303 push @isbn_params, '?';
2307 my $dbh = C4::Context->dbh;
2310 COALESCE(biblio.title, deletedbiblio.title) AS title,
2311 COALESCE(biblio.author, deletedbiblio.author) AS author,
2312 COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2313 COALESCE(biblioitems.ean, deletedbiblioitems.ean) AS ean,
2315 aqbasket.basketname,
2316 aqbasket.basketgroupid,
2317 aqbasket.authorisedby,
2318 concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2319 aqbasketgroups.name as groupname,
2321 aqbasket.creationdate,
2322 aqorders.datereceived,
2324 aqorders.quantityreceived,
2326 aqorders.ordernumber,
2328 aqinvoices.invoicenumber,
2329 aqbooksellers.id as id,
2330 aqorders.biblionumber,
2331 aqorders.orderstatus,
2332 aqorders.parent_ordernumber,
2333 aqbudgets.budget_name
2335 $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2338 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2339 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2340 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2341 LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2342 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2343 LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2344 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2345 LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2346 LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2347 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2350 $query .= " WHERE 1 ";
2352 unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2353 $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2356 my @query_params = ();
2358 if ( $biblionumber ) {
2359 $query .= " AND biblio.biblionumber = ?";
2360 push @query_params, $biblionumber;
2364 $query .= " AND biblio.title LIKE ? ";
2365 $title =~ s/\s+/%/g;
2366 push @query_params, "%$title%";
2370 $query .= " AND biblio.author LIKE ? ";
2371 push @query_params, "%$author%";
2375 $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2376 foreach my $isb (@isbns){
2377 push @query_params, "%$isb%";
2382 $query .= " AND biblioitems.ean = ? ";
2383 push @query_params, "$ean";
2386 $query .= " AND aqbooksellers.name LIKE ? ";
2387 push @query_params, "%$name%";
2391 $query .= " AND aqbudgets.budget_id = ? ";
2392 push @query_params, "$budget";
2395 if ( $from_placed_on ) {
2396 $query .= " AND creationdate >= ? ";
2397 push @query_params, $from_placed_on;
2400 if ( $to_placed_on ) {
2401 $query .= " AND creationdate <= ? ";
2402 push @query_params, $to_placed_on;
2405 if ( defined $orderstatus and $orderstatus ne '') {
2406 $query .= " AND aqorders.orderstatus = ? ";
2407 push @query_params, "$orderstatus";
2411 if ($basket =~ m/^\d+$/) {
2412 $query .= " AND aqorders.basketno = ? ";
2413 push @query_params, $basket;
2415 $query .= " AND aqbasket.basketname LIKE ? ";
2416 push @query_params, "%$basket%";
2420 if ($booksellerinvoicenumber) {
2421 $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2422 push @query_params, "%$booksellerinvoicenumber%";
2425 if ($basketgroupname) {
2426 $query .= " AND aqbasketgroups.name LIKE ? ";
2427 push @query_params, "%$basketgroupname%";
2431 $query .= " AND (aqorders.ordernumber = ? ";
2432 push @query_params, $ordernumber;
2433 if ($search_children_too) {
2434 $query .= " OR aqorders.parent_ordernumber = ? ";
2435 push @query_params, $ordernumber;
2440 if ( @$created_by ) {
2441 $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2442 push @query_params, @$created_by;
2445 if ( @$ordernumbers ) {
2446 $query .= ' AND (aqorders.ordernumber IN ( ' . join (',', ('?') x @$ordernumbers ) . '))';
2447 push @query_params, @$ordernumbers;
2449 if ( @$additional_fields ) {
2450 my @baskets = Koha::Acquisition::Baskets->filter_by_additional_fields($additional_fields);
2452 return [] unless @baskets;
2454 # No parameterization because record IDs come directly from DB
2455 $query .= ' AND aqbasket.basketno IN ( ' . join( ',', map { $_->basketno } @baskets ) . ' )';
2458 if ( C4::Context->preference("IndependentBranches") ) {
2459 unless ( C4::Context->IsSuperLibrarian() ) {
2460 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2461 push @query_params, C4::Context->userenv->{branch};
2464 $query .= " ORDER BY id";
2466 return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2469 =head2 GetRecentAcqui
2471 $results = GetRecentAcqui($days);
2473 C<$results> is a ref to a table which contains hashref
2477 sub GetRecentAcqui {
2479 my $dbh = C4::Context->dbh;
2483 ORDER BY timestamp DESC
2486 my $sth = $dbh->prepare($query);
2488 my $results = $sth->fetchall_arrayref({});
2492 #------------------------------------------------------------#
2496 &AddClaim($ordernumber);
2498 Add a claim for an order
2503 my ($ordernumber) = @_;
2504 my $dbh = C4::Context->dbh;
2507 claims_count = claims_count + 1,
2508 claimed_date = CURDATE()
2509 WHERE ordernumber = ?
2511 my $sth = $dbh->prepare($query);
2512 $sth->execute($ordernumber);
2517 my @invoices = GetInvoices(
2518 invoicenumber => $invoicenumber,
2519 supplierid => $supplierid,
2520 suppliername => $suppliername,
2521 shipmentdatefrom => $shipmentdatefrom, # ISO format
2522 shipmentdateto => $shipmentdateto, # ISO format
2523 billingdatefrom => $billingdatefrom, # ISO format
2524 billingdateto => $billingdateto, # ISO format
2525 isbneanissn => $isbn_or_ean_or_issn,
2528 publisher => $publisher,
2529 publicationyear => $publicationyear,
2530 branchcode => $branchcode,
2531 order_by => $order_by
2534 Return a list of invoices that match all given criteria.
2536 $order_by is "column_name (asc|desc)", where column_name is any of
2537 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2538 'shipmentcost', 'shipmentcost_budgetid'.
2540 asc is the default if omitted
2547 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2548 closedate shipmentcost shipmentcost_budgetid);
2550 my $dbh = C4::Context->dbh;
2552 SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
2553 aqbooksellers.name AS suppliername,
2556 aqorders.datereceived IS NOT NULL,
2557 aqorders.biblionumber,
2560 ) AS receivedbiblios,
2563 aqorders.subscriptionid IS NOT NULL,
2564 aqorders.subscriptionid,
2567 ) AS is_linked_to_subscriptions,
2568 SUM(aqorders.quantityreceived) AS receiveditems
2570 LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2571 LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2572 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2573 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2574 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2575 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2576 LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2581 if($args{supplierid}) {
2582 push @bind_strs, " aqinvoices.booksellerid = ? ";
2583 push @bind_args, $args{supplierid};
2585 if($args{invoicenumber}) {
2586 push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2587 push @bind_args, "%$args{invoicenumber}%";
2589 if($args{suppliername}) {
2590 push @bind_strs, " aqbooksellers.name LIKE ? ";
2591 push @bind_args, "%$args{suppliername}%";
2593 if($args{shipmentdatefrom}) {
2594 push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2595 push @bind_args, $args{shipmentdatefrom};
2597 if($args{shipmentdateto}) {
2598 push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2599 push @bind_args, $args{shipmentdateto};
2601 if($args{billingdatefrom}) {
2602 push @bind_strs, " aqinvoices.billingdate >= ? ";
2603 push @bind_args, $args{billingdatefrom};
2605 if($args{billingdateto}) {
2606 push @bind_strs, " aqinvoices.billingdate <= ? ";
2607 push @bind_args, $args{billingdateto};
2609 if($args{isbneanissn}) {
2610 push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2611 push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2614 push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2615 push @bind_args, $args{title};
2618 push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2619 push @bind_args, $args{author};
2621 if($args{publisher}) {
2622 push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2623 push @bind_args, $args{publisher};
2625 if($args{publicationyear}) {
2626 push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2627 push @bind_args, $args{publicationyear}, $args{publicationyear};
2629 if($args{branchcode}) {
2630 push @bind_strs, " borrowers.branchcode = ? ";
2631 push @bind_args, $args{branchcode};
2633 if($args{message_id}) {
2634 push @bind_strs, " aqinvoices.message_id = ? ";
2635 push @bind_args, $args{message_id};
2638 $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2639 $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";
2641 if($args{order_by}) {
2642 my ($column, $direction) = split / /, $args{order_by};
2643 if(grep /^$column$/, @columns) {
2644 $direction ||= 'ASC';
2645 $query .= " ORDER BY $column $direction";
2649 my $sth = $dbh->prepare($query);
2650 $sth->execute(@bind_args);
2652 my $results = $sth->fetchall_arrayref({});
2658 my $invoice = GetInvoice($invoiceid);
2660 Get informations about invoice with given $invoiceid
2662 Return a hash filled with aqinvoices.* fields
2667 my ($invoiceid) = @_;
2670 return unless $invoiceid;
2672 my $dbh = C4::Context->dbh;
2678 my $sth = $dbh->prepare($query);
2679 $sth->execute($invoiceid);
2681 $invoice = $sth->fetchrow_hashref;
2685 =head3 GetInvoiceDetails
2687 my $invoice = GetInvoiceDetails($invoiceid)
2689 Return informations about an invoice + the list of related order lines
2691 Orders informations are in $invoice->{orders} (array ref)
2695 sub GetInvoiceDetails {
2696 my ($invoiceid) = @_;
2698 if ( !defined $invoiceid ) {
2699 carp 'GetInvoiceDetails called without an invoiceid';
2703 my $dbh = C4::Context->dbh;
2705 SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2707 LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2710 my $sth = $dbh->prepare($query);
2711 $sth->execute($invoiceid);
2713 my $invoice = $sth->fetchrow_hashref;
2718 biblio.copyrightdate,
2720 biblioitems.publishercode,
2721 biblioitems.publicationyear,
2722 aqbasket.basketname,
2723 aqbasketgroups.id AS basketgroupid,
2724 aqbasketgroups.name AS basketgroupname
2726 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2727 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2728 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2729 LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2732 $sth = $dbh->prepare($query);
2733 $sth->execute($invoiceid);
2734 $invoice->{orders} = $sth->fetchall_arrayref({});
2735 $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2742 my $invoiceid = AddInvoice(
2743 invoicenumber => $invoicenumber,
2744 booksellerid => $booksellerid,
2745 shipmentdate => $shipmentdate,
2746 billingdate => $billingdate,
2747 closedate => $closedate,
2748 shipmentcost => $shipmentcost,
2749 shipmentcost_budgetid => $shipmentcost_budgetid
2752 Create a new invoice and return its id or undef if it fails.
2759 return unless(%invoice and $invoice{invoicenumber});
2761 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2762 closedate shipmentcost shipmentcost_budgetid message_id);
2766 foreach my $key (keys %invoice) {
2767 if(0 < grep(/^$key$/, @columns)) {
2768 push @set_strs, "$key = ?";
2769 push @set_args, ($invoice{$key} || undef);
2775 my $dbh = C4::Context->dbh;
2776 my $query = "INSERT INTO aqinvoices SET ";
2777 $query .= join (",", @set_strs);
2778 my $sth = $dbh->prepare($query);
2779 $rv = $sth->execute(@set_args);
2781 $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2790 invoiceid => $invoiceid, # Mandatory
2791 invoicenumber => $invoicenumber,
2792 booksellerid => $booksellerid,
2793 shipmentdate => $shipmentdate,
2794 billingdate => $billingdate,
2795 closedate => $closedate,
2796 shipmentcost => $shipmentcost,
2797 shipmentcost_budgetid => $shipmentcost_budgetid
2800 Modify an invoice, invoiceid is mandatory.
2802 Return undef if it fails.
2809 return unless(%invoice and $invoice{invoiceid});
2811 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2812 closedate shipmentcost shipmentcost_budgetid);
2816 foreach my $key (keys %invoice) {
2817 if(0 < grep(/^$key$/, @columns)) {
2818 push @set_strs, "$key = ?";
2819 push @set_args, ($invoice{$key} || undef);
2823 my $dbh = C4::Context->dbh;
2824 my $query = "UPDATE aqinvoices SET ";
2825 $query .= join(",", @set_strs);
2826 $query .= " WHERE invoiceid = ?";
2828 my $sth = $dbh->prepare($query);
2829 $sth->execute(@set_args, $invoice{invoiceid});
2834 CloseInvoice($invoiceid);
2838 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2843 my ($invoiceid) = @_;
2845 return unless $invoiceid;
2847 my $dbh = C4::Context->dbh;
2850 SET closedate = CAST(NOW() AS DATE)
2853 my $sth = $dbh->prepare($query);
2854 $sth->execute($invoiceid);
2857 =head3 ReopenInvoice
2859 ReopenInvoice($invoiceid);
2863 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2868 my ($invoiceid) = @_;
2870 return unless $invoiceid;
2872 my $dbh = C4::Context->dbh;
2875 SET closedate = NULL
2878 my $sth = $dbh->prepare($query);
2879 $sth->execute($invoiceid);
2884 DelInvoice($invoiceid);
2886 Delete an invoice if there are no items attached to it.
2891 my ($invoiceid) = @_;
2893 return unless $invoiceid;
2895 my $dbh = C4::Context->dbh;
2901 my $sth = $dbh->prepare($query);
2902 $sth->execute($invoiceid);
2903 my $res = $sth->fetchrow_arrayref;
2904 if ( $res && $res->[0] == 0 ) {
2906 DELETE FROM aqinvoices
2909 my $sth = $dbh->prepare($query);
2910 return ( $sth->execute($invoiceid) > 0 );
2915 =head3 MergeInvoices
2917 MergeInvoices($invoiceid, \@sourceids);
2919 Merge the invoices identified by the IDs in \@sourceids into
2920 the invoice identified by $invoiceid.
2925 my ($invoiceid, $sourceids) = @_;
2927 return unless $invoiceid;
2928 foreach my $sourceid (@$sourceids) {
2929 next if $sourceid == $invoiceid;
2930 my $source = GetInvoiceDetails($sourceid);
2931 foreach my $order (@{$source->{'orders'}}) {
2932 $order->{'invoiceid'} = $invoiceid;
2935 DelInvoice($source->{'invoiceid'});
2940 =head3 GetBiblioCountByBasketno
2942 $biblio_count = &GetBiblioCountByBasketno($basketno);
2944 Looks up the biblio's count that has basketno value $basketno
2950 sub GetBiblioCountByBasketno {
2951 my ($basketno) = @_;
2952 my $dbh = C4::Context->dbh;
2954 SELECT COUNT( DISTINCT( biblionumber ) )
2957 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
2960 my $sth = $dbh->prepare($query);
2961 $sth->execute($basketno);
2962 return $sth->fetchrow;
2965 # Note this subroutine should be moved to Koha::Acquisition::Order
2966 # Will do when a DBIC decision will be taken.
2967 sub populate_order_with_prices {
2970 my $order = $params->{order};
2971 my $booksellerid = $params->{booksellerid};
2972 return unless $booksellerid;
2974 my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
2976 my $receiving = $params->{receiving};
2977 my $ordering = $params->{ordering};
2978 my $discount = $order->{discount};
2979 $discount /= 100 if $discount > 1;
2982 $order->{tax_rate_on_ordering} //= $order->{tax_rate};
2983 if ( $bookseller->listincgst ) {
2984 # The user entered the rrp tax included
2985 $order->{rrp_tax_included} = $order->{rrp};
2987 # rrp tax excluded = rrp tax included / ( 1 + tax rate )
2988 $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2990 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2991 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2993 # ecost tax included = rrp tax included ( 1 - discount )
2994 $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
2997 # The user entered the rrp tax excluded
2998 $order->{rrp_tax_excluded} = $order->{rrp};
3000 # rrp tax included = rrp tax excluded * ( 1 - tax rate )
3001 $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
3003 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
3004 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
3006 # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount )
3007 $order->{ecost_tax_included} =
3008 $order->{rrp_tax_excluded} *
3009 ( 1 + $order->{tax_rate_on_ordering} ) *
3013 # tax value = quantity * ecost tax excluded * tax rate
3014 $order->{tax_value_on_ordering} =
3015 $order->{quantity} * $order->{ecost_tax_excluded} * $order->{tax_rate_on_ordering};
3019 $order->{tax_rate_on_receiving} //= $order->{tax_rate};
3020 if ( $bookseller->invoiceincgst ) {
3021 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3022 # we need to keep the exact ecost value
3023 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
3024 $order->{unitprice} = $order->{ecost_tax_included};
3027 # The user entered the unit price tax included
3028 $order->{unitprice_tax_included} = $order->{unitprice};
3030 # unit price tax excluded = unit price tax included / ( 1 + tax rate )
3031 $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
3034 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3035 # we need to keep the exact ecost value
3036 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
3037 $order->{unitprice} = $order->{ecost_tax_excluded};
3040 # The user entered the unit price tax excluded
3041 $order->{unitprice_tax_excluded} = $order->{unitprice};
3044 # unit price tax included = unit price tax included * ( 1 + tax rate )
3045 $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
3048 # tax value = quantity * unit price tax excluded * tax rate
3049 $order->{tax_value_on_receiving} = $order->{quantity} * $order->{unitprice_tax_excluded} * $order->{tax_rate_on_receiving};
3055 =head3 GetOrderUsers
3057 $order_users_ids = &GetOrderUsers($ordernumber);
3059 Returns a list of all borrowernumbers that are in order users list
3064 my ($ordernumber) = @_;
3066 return unless $ordernumber;
3069 SELECT borrowernumber
3071 WHERE ordernumber = ?
3073 my $dbh = C4::Context->dbh;
3074 my $sth = $dbh->prepare($query);
3075 $sth->execute($ordernumber);
3076 my $results = $sth->fetchall_arrayref( {} );
3078 my @borrowernumbers;
3079 foreach (@$results) {
3080 push @borrowernumbers, $_->{'borrowernumber'};
3083 return @borrowernumbers;
3086 =head3 ModOrderUsers
3088 my @order_users_ids = (1, 2, 3);
3089 &ModOrderUsers($ordernumber, @basketusers_ids);
3091 Delete all users from order users list, and add users in C<@order_users_ids>
3097 my ( $ordernumber, @order_users_ids ) = @_;
3099 return unless $ordernumber;
3101 my $dbh = C4::Context->dbh;
3103 DELETE FROM aqorder_users
3104 WHERE ordernumber = ?
3106 my $sth = $dbh->prepare($query);
3107 $sth->execute($ordernumber);
3110 INSERT INTO aqorder_users (ordernumber, borrowernumber)
3113 $sth = $dbh->prepare($query);
3114 foreach my $order_user_id (@order_users_ids) {
3115 $sth->execute( $ordernumber, $order_user_id );
3119 sub NotifyOrderUsers {
3120 my ($ordernumber) = @_;
3122 my @borrowernumbers = GetOrderUsers($ordernumber);
3123 return unless @borrowernumbers;
3125 my $order = GetOrder( $ordernumber );
3126 for my $borrowernumber (@borrowernumbers) {
3127 my $patron = Koha::Patrons->find( $borrowernumber );
3128 my $library = $patron->library->unblessed;
3129 my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed;
3130 my $letter = C4::Letters::GetPreparedLetter(
3131 module => 'acquisition',
3132 letter_code => 'ACQ_NOTIF_ON_RECEIV',
3133 branchcode => $library->{branchcode},
3134 lang => $patron->lang,
3136 'branches' => $library,
3137 'borrowers' => $patron->unblessed,
3138 'biblio' => $biblio,
3139 'aqorders' => $order,
3143 C4::Letters::EnqueueLetter(
3146 borrowernumber => $borrowernumber,
3147 LibraryName => C4::Context->preference("LibraryName"),
3148 message_transport_type => 'email',
3150 ) or warn "can't enqueue letter $letter";
3155 =head3 FillWithDefaultValues
3157 FillWithDefaultValues( $marc_record );
3159 This will update the record with default value defined in the ACQ framework.
3160 For all existing fields, if a default value exists and there are no subfield, it will be created.
3161 If the field does not exist, it will be created too.
3165 sub FillWithDefaultValues {
3167 my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3170 C4::Biblio::GetMarcFromKohaField( 'items.itemnumber', '' );
3171 for my $tag ( sort keys %$tagslib ) {
3173 next if $tag == $itemfield;
3174 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3175 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3176 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3177 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3178 my @fields = $record->field($tag);
3180 for my $field (@fields) {
3181 unless ( defined $field->subfield($subfield) ) {
3182 $field->add_subfields(
3183 $subfield => $defaultvalue );
3188 $record->insert_fields_ordered(
3190 $tag, '', '', $subfield => $defaultvalue
3205 Koha Development Team <http://koha-community.org/>