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::Order;
32 use Koha::Acquisition::Booksellers;
35 use Koha::Number::Price;
37 use Koha::CsvProfiles;
46 use vars qw(@ISA @EXPORT);
52 &GetBasket &NewBasket &CloseBasket &ReopenBasket &DelBasket &ModBasket
53 &GetBasketAsCSV &GetBasketGroupAsCSV
54 &GetBasketsByBookseller &GetBasketsByBasketgroup
55 &GetBasketsInfosByBookseller
57 &GetBasketUsers &ModBasketUsers
62 &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup
63 &GetBasketgroups &ReOpenBasketgroup
65 &DelOrder &ModOrder &GetOrder &GetOrders &GetOrdersByBiblionumber
66 &GetLateOrders &GetOrderFromItemnumber
67 &SearchOrders &GetHistory &GetRecentAcqui
68 &ModReceiveOrder &CancelReceipt
70 &GetLastOrderNotReceivedFromSubscriptionid &GetLastOrderReceivedFromSubscriptionid
85 &GetItemnumbersFromOrder
88 &GetBiblioCountByBasketno
94 &FillWithDefaultValues
102 sub GetOrderFromItemnumber {
103 my ($itemnumber) = @_;
104 my $dbh = C4::Context->dbh;
107 SELECT * from aqorders LEFT JOIN aqorders_items
108 ON ( aqorders.ordernumber = aqorders_items.ordernumber )
109 WHERE itemnumber = ? |;
111 my $sth = $dbh->prepare($query);
115 $sth->execute($itemnumber);
117 my $order = $sth->fetchrow_hashref;
122 # Returns the itemnumber(s) associated with the ordernumber given in parameter
123 sub GetItemnumbersFromOrder {
124 my ($ordernumber) = @_;
125 my $dbh = C4::Context->dbh;
126 my $query = "SELECT itemnumber FROM aqorders_items WHERE ordernumber=?";
127 my $sth = $dbh->prepare($query);
128 $sth->execute($ordernumber);
131 while (my $order = $sth->fetchrow_hashref) {
132 push @tab, $order->{'itemnumber'};
146 C4::Acquisition - Koha functions for dealing with orders and acquisitions
154 The functions in this module deal with acquisitions, managing book
155 orders, basket and parcels.
159 =head2 FUNCTIONS ABOUT BASKETS
163 $aqbasket = &GetBasket($basketnumber);
165 get all basket informations in aqbasket for a given basket
167 B<returns:> informations for a given basket returned as a hashref.
173 my $dbh = C4::Context->dbh;
176 concat( b.firstname,' ',b.surname) AS authorisedbyname
178 LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
181 my $sth=$dbh->prepare($query);
182 $sth->execute($basketno);
183 my $basket = $sth->fetchrow_hashref;
187 #------------------------------------------------------------#
191 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
192 $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace, $is_standing );
194 Create a new basket in aqbasket table
198 =item C<$booksellerid> is a foreign key in the aqbasket table
200 =item C<$authorizedby> is the username of who created the basket
204 The other parameters are optional, see ModBasketHeader for more info on them.
209 my ( $booksellerid, $authorisedby, $basketname, $basketnote,
210 $basketbooksellernote, $basketcontractnumber, $deliveryplace,
211 $billingplace, $is_standing ) = @_;
212 my $dbh = C4::Context->dbh;
214 'INSERT INTO aqbasket (creationdate,booksellerid,authorisedby) '
215 . 'VALUES (now(),?,?)';
216 $dbh->do( $query, {}, $booksellerid, $authorisedby );
218 my $basket = $dbh->{mysql_insertid};
219 $basketname ||= q{}; # default to empty strings
221 $basketbooksellernote ||= q{};
222 ModBasketHeader( $basket, $basketname, $basketnote, $basketbooksellernote,
223 $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing );
227 #------------------------------------------------------------#
231 &CloseBasket($basketno);
233 close a basket (becomes unmodifiable, except for receives)
239 my $dbh = C4::Context->dbh;
240 $dbh->do('UPDATE aqbasket SET closedate=now() WHERE basketno=?', {}, $basketno );
242 $dbh->do( q{UPDATE aqorders SET orderstatus = 'ordered' WHERE basketno = ? AND orderstatus != 'complete'},
249 &ReopenBasket($basketno);
257 my $dbh = C4::Context->dbh;
258 $dbh->do( q{UPDATE aqbasket SET closedate=NULL WHERE basketno=?}, {}, $basketno );
262 SET orderstatus = 'new'
264 AND orderstatus != 'complete'
269 #------------------------------------------------------------#
271 =head3 GetBasketAsCSV
273 &GetBasketAsCSV($basketno);
275 Export a basket as CSV
277 $cgi parameter is needed for column name translation
282 my ($basketno, $cgi, $csv_profile_id) = @_;
283 my $basket = GetBasket($basketno);
284 my @orders = GetOrders($basketno);
285 my $contract = GetContract({
286 contractnumber => $basket->{'contractnumber'}
289 my $template = C4::Templates::gettemplate("acqui/csv/basket.tt", "intranet", $cgi);
291 if ($csv_profile_id) {
292 my $csv_profile = Koha::CsvProfiles->find( $csv_profile_id );
293 die "There is no valid csv profile given" unless $csv_profile;
295 my $csv = Text::CSV_XS->new({'quote_char'=>'"','escape_char'=>'"','sep_char'=>$csv_profile->csv_separator,'binary'=>1});
296 my $csv_profile_content = $csv_profile->content;
297 my ( @headers, @fields );
298 while ( $csv_profile_content =~ /
301 ([^\|]*) # fieldname (table.row or row)
305 my $field = ($2 eq '') ? $1 : $2;
307 $header =~ s/^\s+|\s+$//g; # Trim whitespaces
308 push @headers, $header;
310 $field =~ s/[^\.]*\.{1}//; # Remove the table name if exists.
311 $field =~ s/^\s+|\s+$//g; # Trim whitespaces
312 push @fields, $field;
314 for my $order (@orders) {
316 my $bd = GetBiblioData( $order->{'biblionumber'} );
317 my @biblioitems = GetBiblioItemByBiblioNumber( $order->{'biblionumber'});
318 for my $biblioitem (@biblioitems) {
319 if ( $biblioitem->{isbn}
321 and $biblioitem->{isbn} eq $order->{isbn} )
323 $order = { %$order, %$biblioitem };
327 $order = {%$order, %$contract};
329 $order = {%$order, %$basket, %$bd};
330 for my $field (@fields) {
331 push @row, $order->{$field};
335 my $content = join( $csv_profile->csv_separator, @headers ) . "\n";
336 for my $row ( @rows ) {
337 $csv->combine(@$row);
338 my $string = $csv->string;
339 $content .= $string . "\n";
344 foreach my $order (@orders) {
345 my $bd = GetBiblioData( $order->{'biblionumber'} );
347 contractname => $contract->{'contractname'},
348 ordernumber => $order->{'ordernumber'},
349 entrydate => $order->{'entrydate'},
350 isbn => $order->{'isbn'},
351 author => $bd->{'author'},
352 title => $bd->{'title'},
353 publicationyear => $bd->{'publicationyear'},
354 publishercode => $bd->{'publishercode'},
355 collectiontitle => $bd->{'collectiontitle'},
356 notes => $order->{'order_vendornote'},
357 quantity => $order->{'quantity'},
358 rrp => $order->{'rrp'},
360 for my $place ( qw( deliveryplace billingplace ) ) {
361 if ( my $library = Koha::Libraries->find( $row->{deliveryplace} ) ) {
362 $row->{$place} = $library->branchname
366 contractname author title publishercode collectiontitle notes
367 deliveryplace billingplace
369 # Double the quotes to not be interpreted as a field end
370 $row->{$_} =~ s/"/""/g if $row->{$_};
376 if(defined $a->{publishercode} and defined $b->{publishercode}) {
377 $a->{publishercode} cmp $b->{publishercode};
381 $template->param(rows => \@rows);
383 return $template->output;
388 =head3 GetBasketGroupAsCSV
390 &GetBasketGroupAsCSV($basketgroupid);
392 Export a basket group as CSV
394 $cgi parameter is needed for column name translation
398 sub GetBasketGroupAsCSV {
399 my ($basketgroupid, $cgi) = @_;
400 my $baskets = GetBasketsByBasketgroup($basketgroupid);
402 my $template = C4::Templates::gettemplate('acqui/csv/basketgroup.tt', 'intranet', $cgi);
405 for my $basket (@$baskets) {
406 my @orders = GetOrders( $basket->{basketno} );
407 my $contract = GetContract({
408 contractnumber => $basket->{contractnumber}
410 my $bookseller = Koha::Acquisition::Booksellers->find( $basket->{booksellerid} );
411 my $basketgroup = GetBasketgroup( $$basket{basketgroupid} );
413 foreach my $order (@orders) {
414 my $bd = GetBiblioData( $order->{'biblionumber'} );
416 clientnumber => $bookseller->accountnumber,
417 basketname => $basket->{basketname},
418 ordernumber => $order->{ordernumber},
419 author => $bd->{author},
420 title => $bd->{title},
421 publishercode => $bd->{publishercode},
422 publicationyear => $bd->{publicationyear},
423 collectiontitle => $bd->{collectiontitle},
424 isbn => $order->{isbn},
425 quantity => $order->{quantity},
426 rrp_tax_included => $order->{rrp_tax_included},
427 rrp_tax_excluded => $order->{rrp_tax_excluded},
428 discount => $bookseller->discount,
429 ecost_tax_included => $order->{ecost_tax_included},
430 ecost_tax_excluded => $order->{ecost_tax_excluded},
431 notes => $order->{order_vendornote},
432 entrydate => $order->{entrydate},
433 booksellername => $bookseller->name,
434 bookselleraddress => $bookseller->address1,
435 booksellerpostal => $bookseller->postal,
436 contractnumber => $contract->{contractnumber},
437 contractname => $contract->{contractname},
440 basketgroupdeliveryplace => $basketgroup->{deliveryplace},
441 basketgroupbillingplace => $basketgroup->{billingplace},
442 basketdeliveryplace => $basket->{deliveryplace},
443 basketbillingplace => $basket->{billingplace},
445 for my $place (qw( basketgroupdeliveryplace basketgroupbillingplace basketdeliveryplace basketbillingplace )) {
446 if ( my $library = Koha::Libraries->find( $temp->{$place} ) ) {
447 $row->{$place} = $library->branchname;
451 basketname author title publishercode collectiontitle notes
452 booksellername bookselleraddress booksellerpostal contractname
453 basketgroupdeliveryplace basketgroupbillingplace
454 basketdeliveryplace basketbillingplace
456 # Double the quotes to not be interpreted as a field end
457 $row->{$_} =~ s/"/""/g if $row->{$_};
462 $template->param(rows => \@rows);
464 return $template->output;
468 =head3 CloseBasketgroup
470 &CloseBasketgroup($basketgroupno);
476 sub CloseBasketgroup {
477 my ($basketgroupno) = @_;
478 my $dbh = C4::Context->dbh;
479 my $sth = $dbh->prepare("
480 UPDATE aqbasketgroups
484 $sth->execute($basketgroupno);
487 #------------------------------------------------------------#
489 =head3 ReOpenBaskergroup($basketgroupno)
491 &ReOpenBaskergroup($basketgroupno);
497 sub ReOpenBasketgroup {
498 my ($basketgroupno) = @_;
499 my $dbh = C4::Context->dbh;
500 my $sth = $dbh->prepare("
501 UPDATE aqbasketgroups
505 $sth->execute($basketgroupno);
508 #------------------------------------------------------------#
513 &DelBasket($basketno);
515 Deletes the basket that has basketno field $basketno in the aqbasket table.
519 =item C<$basketno> is the primary key of the basket in the aqbasket table.
526 my ( $basketno ) = @_;
527 my $query = "DELETE FROM aqbasket WHERE basketno=?";
528 my $dbh = C4::Context->dbh;
529 my $sth = $dbh->prepare($query);
530 $sth->execute($basketno);
534 #------------------------------------------------------------#
538 &ModBasket($basketinfo);
540 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
544 =item C<$basketno> is the primary key of the basket in the aqbasket table.
551 my $basketinfo = shift;
552 my $query = "UPDATE aqbasket SET ";
554 foreach my $key (keys %$basketinfo){
555 if ($key ne 'basketno'){
556 $query .= "$key=?, ";
557 push(@params, $basketinfo->{$key} || undef );
560 # get rid of the "," at the end of $query
561 if (substr($query, length($query)-2) eq ', '){
566 $query .= "WHERE basketno=?";
567 push(@params, $basketinfo->{'basketno'});
568 my $dbh = C4::Context->dbh;
569 my $sth = $dbh->prepare($query);
570 $sth->execute(@params);
575 #------------------------------------------------------------#
577 =head3 ModBasketHeader
579 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
581 Modifies a basket's header.
585 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
587 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
589 =item C<$note> is the "note" field in the "aqbasket" table;
591 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
593 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
595 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
597 =item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
599 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
601 =item C<$is_standing> is the "is_standing" field in the aqbasket table.
607 sub ModBasketHeader {
608 my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing) = @_;
611 SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=?, is_standing=?
615 my $dbh = C4::Context->dbh;
616 my $sth = $dbh->prepare($query);
617 $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $is_standing, $basketno);
619 if ( $contractnumber ) {
620 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
621 my $sth2 = $dbh->prepare($query2);
622 $sth2->execute($contractnumber,$basketno);
627 #------------------------------------------------------------#
629 =head3 GetBasketsByBookseller
631 @results = &GetBasketsByBookseller($booksellerid, $extra);
633 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
637 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
639 =item C<$extra> is the extra sql parameters, can be
641 $extra->{groupby}: group baskets by column
642 ex. $extra->{groupby} = aqbasket.basketgroupid
643 $extra->{orderby}: order baskets by column
644 $extra->{limit}: limit number of results (can be helpful for pagination)
650 sub GetBasketsByBookseller {
651 my ($booksellerid, $extra) = @_;
652 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
654 if ($extra->{groupby}) {
655 $query .= " GROUP by $extra->{groupby}";
657 if ($extra->{orderby}){
658 $query .= " ORDER by $extra->{orderby}";
660 if ($extra->{limit}){
661 $query .= " LIMIT $extra->{limit}";
664 my $dbh = C4::Context->dbh;
665 my $sth = $dbh->prepare($query);
666 $sth->execute($booksellerid);
667 return $sth->fetchall_arrayref({});
670 =head3 GetBasketsInfosByBookseller
672 my $baskets = GetBasketsInfosByBookseller($supplierid, $allbaskets);
674 The optional second parameter allbaskets is a boolean allowing you to
675 select all baskets from the supplier; by default only active baskets (open or
676 closed but still something to receive) are returned.
678 Returns in a arrayref of hashref all about booksellers baskets, plus:
679 total_biblios: Number of distinct biblios in basket
680 total_items: Number of items in basket
681 expected_items: Number of non-received items in basket
685 sub GetBasketsInfosByBookseller {
686 my ($supplierid, $allbaskets) = @_;
688 return unless $supplierid;
690 my $dbh = C4::Context->dbh;
693 SUM(aqorders.quantity) AS total_items,
695 IF ( aqorders.orderstatus = 'cancelled', aqorders.quantity, 0 )
696 ) AS total_items_cancelled,
697 COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
699 IF(aqorders.datereceived IS NULL
700 AND aqorders.datecancellationprinted IS NULL
705 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
706 WHERE booksellerid = ?};
708 unless ( $allbaskets ) {
709 $query.=" AND (closedate IS NULL OR (aqorders.quantity > aqorders.quantityreceived AND datecancellationprinted IS NULL))";
711 $query.=" GROUP BY aqbasket.basketno";
713 my $sth = $dbh->prepare($query);
714 $sth->execute($supplierid);
715 my $baskets = $sth->fetchall_arrayref({});
717 # Retrieve the number of biblios cancelled
718 my $cancelled_biblios = $dbh->selectall_hashref( q|
719 SELECT COUNT(DISTINCT(biblionumber)) AS total_biblios_cancelled, aqbasket.basketno
721 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
722 WHERE booksellerid = ?
723 AND aqorders.orderstatus = 'cancelled'
724 GROUP BY aqbasket.basketno
725 |, 'basketno', {}, $supplierid );
727 $_->{total_biblios_cancelled} = $cancelled_biblios->{$_->{basketno}}{total_biblios_cancelled} || 0
733 =head3 GetBasketUsers
735 $basketusers_ids = &GetBasketUsers($basketno);
737 Returns a list of all borrowernumbers that are in basket users list
742 my $basketno = shift;
744 return unless $basketno;
747 SELECT borrowernumber
751 my $dbh = C4::Context->dbh;
752 my $sth = $dbh->prepare($query);
753 $sth->execute($basketno);
754 my $results = $sth->fetchall_arrayref( {} );
757 foreach (@$results) {
758 push @borrowernumbers, $_->{'borrowernumber'};
761 return @borrowernumbers;
764 =head3 ModBasketUsers
766 my @basketusers_ids = (1, 2, 3);
767 &ModBasketUsers($basketno, @basketusers_ids);
769 Delete all users from basket users list, and add users in C<@basketusers_ids>
775 my ($basketno, @basketusers_ids) = @_;
777 return unless $basketno;
779 my $dbh = C4::Context->dbh;
781 DELETE FROM aqbasketusers
784 my $sth = $dbh->prepare($query);
785 $sth->execute($basketno);
788 INSERT INTO aqbasketusers (basketno, borrowernumber)
791 $sth = $dbh->prepare($query);
792 foreach my $basketuser_id (@basketusers_ids) {
793 $sth->execute($basketno, $basketuser_id);
798 =head3 CanUserManageBasket
800 my $bool = CanUserManageBasket($borrower, $basket[, $userflags]);
801 my $bool = CanUserManageBasket($borrowernumber, $basketno[, $userflags]);
803 Check if a borrower can manage a basket, according to system preference
804 AcqViewBaskets, user permissions and basket properties (creator, users list,
807 First parameter can be either a borrowernumber or a hashref as returned by
808 C4::Members::GetMember.
810 Second parameter can be either a basketno or a hashref as returned by
811 C4::Acquisition::GetBasket.
813 The third parameter is optional. If given, it should be a hashref as returned
814 by C4::Auth::getuserflags. If not, getuserflags is called.
816 If user is authorised to manage basket, returns 1.
821 sub CanUserManageBasket {
822 my ($borrower, $basket, $userflags) = @_;
824 if (!ref $borrower) {
825 $borrower = C4::Members::GetMember(borrowernumber => $borrower);
828 $basket = GetBasket($basket);
831 return 0 unless ($basket and $borrower);
833 my $borrowernumber = $borrower->{borrowernumber};
834 my $basketno = $basket->{basketno};
836 my $AcqViewBaskets = C4::Context->preference('AcqViewBaskets');
838 if (!defined $userflags) {
839 my $dbh = C4::Context->dbh;
840 my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE borrowernumber = ?");
841 $sth->execute($borrowernumber);
842 my ($flags) = $sth->fetchrow_array;
845 $userflags = C4::Auth::getuserflags($flags, $borrower->{userid}, $dbh);
848 unless ($userflags->{superlibrarian}
849 || (ref $userflags->{acquisition} && $userflags->{acquisition}->{order_manage_all})
850 || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
852 if (not exists $userflags->{acquisition}) {
856 if ( (ref $userflags->{acquisition} && !$userflags->{acquisition}->{order_manage})
857 || (!ref $userflags->{acquisition} && !$userflags->{acquisition}) ) {
861 if ($AcqViewBaskets eq 'user'
862 && $basket->{authorisedby} != $borrowernumber
863 && ! grep { $borrowernumber eq $_ } GetBasketUsers($basketno)) {
867 if ($AcqViewBaskets eq 'branch' && defined $basket->{branch}
868 && $basket->{branch} ne $borrower->{branchcode}) {
876 #------------------------------------------------------------#
878 =head3 GetBasketsByBasketgroup
880 $baskets = &GetBasketsByBasketgroup($basketgroupid);
882 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
886 sub GetBasketsByBasketgroup {
887 my $basketgroupid = shift;
889 SELECT *, aqbasket.booksellerid as booksellerid
891 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?
893 my $dbh = C4::Context->dbh;
894 my $sth = $dbh->prepare($query);
895 $sth->execute($basketgroupid);
896 return $sth->fetchall_arrayref({});
899 #------------------------------------------------------------#
901 =head3 NewBasketgroup
903 $basketgroupid = NewBasketgroup(\%hashref);
905 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
907 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
909 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
911 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
913 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
915 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
917 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
919 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
921 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
926 my $basketgroupinfo = shift;
927 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
928 my $query = "INSERT INTO aqbasketgroups (";
930 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
931 if ( defined $basketgroupinfo->{$field} ) {
932 $query .= "$field, ";
933 push(@params, $basketgroupinfo->{$field});
936 $query .= "booksellerid) VALUES (";
941 push(@params, $basketgroupinfo->{'booksellerid'});
942 my $dbh = C4::Context->dbh;
943 my $sth = $dbh->prepare($query);
944 $sth->execute(@params);
945 my $basketgroupid = $dbh->{'mysql_insertid'};
946 if( $basketgroupinfo->{'basketlist'} ) {
947 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
948 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
949 my $sth2 = $dbh->prepare($query2);
950 $sth2->execute($basketgroupid, $basketno);
953 return $basketgroupid;
956 #------------------------------------------------------------#
958 =head3 ModBasketgroup
960 ModBasketgroup(\%hashref);
962 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
964 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
966 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
968 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
970 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
972 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
974 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
976 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
978 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
983 my $basketgroupinfo = shift;
984 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
985 my $dbh = C4::Context->dbh;
986 my $query = "UPDATE aqbasketgroups SET ";
988 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
989 if ( defined $basketgroupinfo->{$field} ) {
990 $query .= "$field=?, ";
991 push(@params, $basketgroupinfo->{$field});
996 $query .= " WHERE id=?";
997 push(@params, $basketgroupinfo->{'id'});
998 my $sth = $dbh->prepare($query);
999 $sth->execute(@params);
1001 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
1002 $sth->execute($basketgroupinfo->{'id'});
1004 if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
1005 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
1006 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
1007 $sth->execute($basketgroupinfo->{'id'}, $basketno);
1013 #------------------------------------------------------------#
1015 =head3 DelBasketgroup
1017 DelBasketgroup($basketgroupid);
1019 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
1023 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
1029 sub DelBasketgroup {
1030 my $basketgroupid = shift;
1031 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1032 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
1033 my $dbh = C4::Context->dbh;
1034 my $sth = $dbh->prepare($query);
1035 $sth->execute($basketgroupid);
1039 #------------------------------------------------------------#
1042 =head2 FUNCTIONS ABOUT ORDERS
1044 =head3 GetBasketgroup
1046 $basketgroup = &GetBasketgroup($basketgroupid);
1048 Returns a reference to the hash containing all information about the basketgroup.
1052 sub GetBasketgroup {
1053 my $basketgroupid = shift;
1054 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1055 my $dbh = C4::Context->dbh;
1056 my $result_set = $dbh->selectall_arrayref(
1057 'SELECT * FROM aqbasketgroups WHERE id=?',
1061 return $result_set->[0]; # id is unique
1064 #------------------------------------------------------------#
1066 =head3 GetBasketgroups
1068 $basketgroups = &GetBasketgroups($booksellerid);
1070 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
1074 sub GetBasketgroups {
1075 my $booksellerid = shift;
1076 die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
1077 my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
1078 my $dbh = C4::Context->dbh;
1079 my $sth = $dbh->prepare($query);
1080 $sth->execute($booksellerid);
1081 return $sth->fetchall_arrayref({});
1084 #------------------------------------------------------------#
1086 =head2 FUNCTIONS ABOUT ORDERS
1090 @orders = &GetOrders( $basketno, { orderby => 'biblio.title', cancelled => 0|1 } );
1092 Looks up the pending (non-cancelled) orders with the given basket
1095 If cancelled is set, only cancelled orders will be returned.
1100 my ( $basketno, $params ) = @_;
1102 return () unless $basketno;
1104 my $orderby = $params->{orderby};
1105 my $cancelled = $params->{cancelled} || 0;
1107 my $dbh = C4::Context->dbh;
1109 SELECT biblio.*,biblioitems.*,
1113 $query .= $cancelled
1115 aqorders_transfers.ordernumber_to AS transferred_to,
1116 aqorders_transfers.timestamp AS transferred_to_timestamp
1119 aqorders_transfers.ordernumber_from AS transferred_from,
1120 aqorders_transfers.timestamp AS transferred_from_timestamp
1124 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1125 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1126 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1128 $query .= $cancelled
1130 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
1133 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1141 $orderby ||= q|biblioitems.publishercode, biblio.title|;
1143 AND (datecancellationprinted IS NOT NULL
1144 AND datecancellationprinted <> '0000-00-00')
1149 q|aqorders.datecancellationprinted desc, aqorders.timestamp desc|;
1151 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
1155 $query .= " ORDER BY $orderby";
1157 $dbh->selectall_arrayref( $query, { Slice => {} }, $basketno );
1162 #------------------------------------------------------------#
1164 =head3 GetOrdersByBiblionumber
1166 @orders = &GetOrdersByBiblionumber($biblionumber);
1168 Looks up the orders with linked to a specific $biblionumber, including
1169 cancelled orders and received orders.
1172 C<@orders> is an array of references-to-hash, whose keys are the
1173 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
1177 sub GetOrdersByBiblionumber {
1178 my $biblionumber = shift;
1179 return unless $biblionumber;
1180 my $dbh = C4::Context->dbh;
1182 SELECT biblio.*,biblioitems.*,
1186 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1187 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1188 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1189 WHERE aqorders.biblionumber=?
1192 $dbh->selectall_arrayref( $query, { Slice => {} }, $biblionumber );
1193 return @{$result_set};
1197 #------------------------------------------------------------#
1201 $order = &GetOrder($ordernumber);
1203 Looks up an order by order number.
1205 Returns a reference-to-hash describing the order. The keys of
1206 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1211 my ($ordernumber) = @_;
1212 return unless $ordernumber;
1214 my $dbh = C4::Context->dbh;
1215 my $query = qq{SELECT
1219 aqbasket.basketname,
1220 borrowers.branchcode,
1221 biblioitems.publicationyear,
1222 biblio.copyrightdate,
1223 biblioitems.editionstatement,
1227 biblioitems.publishercode,
1228 aqorders.rrp AS unitpricesupplier,
1229 aqorders.ecost AS unitpricelib,
1230 aqorders.claims_count AS claims_count,
1231 aqorders.claimed_date AS claimed_date,
1232 aqbudgets.budget_name AS budget,
1233 aqbooksellers.name AS supplier,
1234 aqbooksellers.id AS supplierid,
1235 biblioitems.publishercode AS publisher,
1236 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1237 DATE(aqbasket.closedate) AS orderdate,
1238 aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity_to_receive,
1239 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1240 DATEDIFF(CURDATE( ),closedate) AS latesince
1241 FROM aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1242 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1243 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1244 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
1245 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1246 WHERE aqorders.basketno = aqbasket.basketno
1249 $dbh->selectall_arrayref( $query, { Slice => {} }, $ordernumber );
1251 # result_set assumed to contain 1 match
1252 return $result_set->[0];
1255 =head3 GetLastOrderNotReceivedFromSubscriptionid
1257 $order = &GetLastOrderNotReceivedFromSubscriptionid($subscriptionid);
1259 Returns a reference-to-hash describing the last order not received for a subscription.
1263 sub GetLastOrderNotReceivedFromSubscriptionid {
1264 my ( $subscriptionid ) = @_;
1265 my $dbh = C4::Context->dbh;
1267 SELECT * FROM aqorders
1268 LEFT JOIN subscription
1269 ON ( aqorders.subscriptionid = subscription.subscriptionid )
1270 WHERE aqorders.subscriptionid = ?
1271 AND aqorders.datereceived IS NULL
1275 $dbh->selectall_arrayref( $query, { Slice => {} }, $subscriptionid );
1277 # result_set assumed to contain 1 match
1278 return $result_set->[0];
1281 =head3 GetLastOrderReceivedFromSubscriptionid
1283 $order = &GetLastOrderReceivedFromSubscriptionid($subscriptionid);
1285 Returns a reference-to-hash describing the last order received for a subscription.
1289 sub GetLastOrderReceivedFromSubscriptionid {
1290 my ( $subscriptionid ) = @_;
1291 my $dbh = C4::Context->dbh;
1293 SELECT * FROM aqorders
1294 LEFT JOIN subscription
1295 ON ( aqorders.subscriptionid = subscription.subscriptionid )
1296 WHERE aqorders.subscriptionid = ?
1297 AND aqorders.datereceived =
1299 SELECT MAX( aqorders.datereceived )
1301 LEFT JOIN subscription
1302 ON ( aqorders.subscriptionid = subscription.subscriptionid )
1303 WHERE aqorders.subscriptionid = ?
1304 AND aqorders.datereceived IS NOT NULL
1306 ORDER BY ordernumber DESC
1310 $dbh->selectall_arrayref( $query, { Slice => {} }, $subscriptionid, $subscriptionid );
1312 # result_set assumed to contain 1 match
1313 return $result_set->[0];
1317 #------------------------------------------------------------#
1321 &ModOrder(\%hashref);
1323 Modifies an existing order. Updates the order with order number
1324 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1325 other keys of the hash update the fields with the same name in the aqorders
1326 table of the Koha database.
1331 my $orderinfo = shift;
1333 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '';
1335 my $dbh = C4::Context->dbh;
1338 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1339 $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1341 # delete($orderinfo->{'branchcode'});
1342 # the hash contains a lot of entries not in aqorders, so get the columns ...
1343 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1345 my $colnames = $sth->{NAME};
1346 #FIXME Be careful. If aqorders would have columns with diacritics,
1347 #you should need to decode what you get back from NAME.
1348 #See report 10110 and guided_reports.pl
1349 my $query = "UPDATE aqorders SET ";
1351 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1352 # ... and skip hash entries that are not in the aqorders table
1353 # FIXME : probably not the best way to do it (would be better to have a correct hash)
1354 next unless grep(/^$orderinfokey$/, @$colnames);
1355 $query .= "$orderinfokey=?, ";
1356 push(@params, $orderinfo->{$orderinfokey});
1359 $query .= "timestamp=NOW() WHERE ordernumber=?";
1360 push(@params, $orderinfo->{'ordernumber'} );
1361 $sth = $dbh->prepare($query);
1362 $sth->execute(@params);
1366 #------------------------------------------------------------#
1370 ModItemOrder($itemnumber, $ordernumber);
1372 Modifies the ordernumber of an item in aqorders_items.
1377 my ($itemnumber, $ordernumber) = @_;
1379 return unless ($itemnumber and $ordernumber);
1381 my $dbh = C4::Context->dbh;
1383 UPDATE aqorders_items
1385 WHERE itemnumber = ?
1387 my $sth = $dbh->prepare($query);
1388 return $sth->execute($ordernumber, $itemnumber);
1391 #------------------------------------------------------------#
1393 =head3 ModReceiveOrder
1395 my ( $date_received, $new_ordernumber ) = ModReceiveOrder(
1397 biblionumber => $biblionumber,
1399 quantityreceived => $quantityreceived,
1401 invoice => $invoice,
1402 budget_id => $budget_id,
1403 received_itemnumbers => \@received_itemnumbers,
1404 order_internalnote => $order_internalnote,
1408 Updates an order, to reflect the fact that it was received, at least
1411 If a partial order is received, splits the order into two.
1413 Updates the order with biblionumber C<$biblionumber> and ordernumber
1414 C<$order->{ordernumber}>.
1419 sub ModReceiveOrder {
1421 my $biblionumber = $params->{biblionumber};
1422 my $order = { %{ $params->{order} } }; # Copy the order, we don't want to modify it
1423 my $invoice = $params->{invoice};
1424 my $quantrec = $params->{quantityreceived};
1425 my $user = $params->{user};
1426 my $budget_id = $params->{budget_id};
1427 my $received_items = $params->{received_items};
1429 my $dbh = C4::Context->dbh;
1430 my $datereceived = ( $invoice and $invoice->{datereceived} ) ? $invoice->{datereceived} : dt_from_string;
1431 my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1432 if ($suggestionid) {
1433 ModSuggestion( {suggestionid=>$suggestionid,
1434 STATUS=>'AVAILABLE',
1435 biblionumber=> $biblionumber}
1439 my $result_set = $dbh->selectrow_arrayref(
1440 q{SELECT aqbasket.is_standing
1442 WHERE basketno=?},{ Slice => {} }, $order->{basketno});
1443 my $is_standing = $result_set->[0]; # we assume we have a unique basket
1445 my $new_ordernumber = $order->{ordernumber};
1446 if ( $is_standing || $order->{quantity} > $quantrec ) {
1447 # Split order line in two parts: the first is the original order line
1448 # without received items (the quantity is decreased),
1449 # the second part is a new order line with quantity=quantityrec
1450 # (entirely received)
1454 orderstatus = 'partial'|;
1455 $query .= q|, order_internalnote = ?| if defined $order->{order_internalnote};
1456 $query .= q| WHERE ordernumber = ?|;
1457 my $sth = $dbh->prepare($query);
1460 ( $is_standing ? 1 : ($order->{quantity} - $quantrec) ),
1461 ( defined $order->{order_internalnote} ? $order->{order_internalnote} : () ),
1462 $order->{ordernumber}
1465 # Recalculate tax_value
1469 tax_value_on_ordering = quantity * ecost_tax_excluded * tax_rate_on_ordering,
1470 tax_value_on_receiving = quantity * unitprice_tax_excluded * tax_rate_on_receiving
1471 WHERE ordernumber = ?
1472 |, undef, $order->{ordernumber});
1474 delete $order->{ordernumber};
1475 $order->{budget_id} = ( $budget_id || $order->{budget_id} );
1476 $order->{quantity} = $quantrec;
1477 $order->{quantityreceived} = $quantrec;
1478 $order->{ecost_tax_excluded} //= 0;
1479 $order->{tax_rate_on_ordering} //= 0;
1480 $order->{unitprice_tax_excluded} //= 0;
1481 $order->{tax_rate_on_receiving} //= 0;
1482 $order->{tax_value_on_ordering} = $order->{quantity} * $order->{ecost_tax_excluded} * $order->{tax_rate_on_ordering};
1483 $order->{tax_value_on_receiving} = $order->{quantity} * $order->{unitprice_tax_excluded} * $order->{tax_rate_on_receiving};
1484 $order->{datereceived} = $datereceived;
1485 $order->{invoiceid} = $invoice->{invoiceid};
1486 $order->{orderstatus} = 'complete';
1487 $new_ordernumber = Koha::Acquisition::Order->new($order)->insert->{ordernumber};
1489 if ($received_items) {
1490 foreach my $itemnumber (@$received_items) {
1491 ModItemOrder($itemnumber, $new_ordernumber);
1497 SET quantityreceived = ?,
1501 orderstatus = 'complete'
1505 , unitprice = ?, unitprice_tax_included = ?, unitprice_tax_excluded = ?
1506 | if defined $order->{unitprice};
1509 ,tax_value_on_receiving = ?
1510 | if defined $order->{tax_value_on_receiving};
1513 ,tax_rate_on_receiving = ?
1514 | if defined $order->{tax_rate_on_receiving};
1517 , order_internalnote = ?
1518 | if defined $order->{order_internalnote};
1520 $query .= q| where biblionumber=? and ordernumber=?|;
1522 my $sth = $dbh->prepare( $query );
1523 my @params = ( $quantrec, $datereceived, $invoice->{invoiceid}, ( $budget_id ? $budget_id : $order->{budget_id} ) );
1525 if ( defined $order->{unitprice} ) {
1526 push @params, $order->{unitprice}, $order->{unitprice_tax_included}, $order->{unitprice_tax_excluded};
1529 if ( defined $order->{tax_value_on_receiving} ) {
1530 push @params, $order->{tax_value_on_receiving};
1533 if ( defined $order->{tax_rate_on_receiving} ) {
1534 push @params, $order->{tax_rate_on_receiving};
1537 if ( defined $order->{order_internalnote} ) {
1538 push @params, $order->{order_internalnote};
1541 push @params, ( $biblionumber, $order->{ordernumber} );
1543 $sth->execute( @params );
1545 # All items have been received, sent a notification to users
1546 NotifyOrderUsers( $order->{ordernumber} );
1549 return ($datereceived, $new_ordernumber);
1552 =head3 CancelReceipt
1554 my $parent_ordernumber = CancelReceipt($ordernumber);
1556 Cancel an order line receipt and update the parent order line, as if no
1558 If items are created at receipt (AcqCreateItem = receiving) then delete
1564 my $ordernumber = shift;
1566 return unless $ordernumber;
1568 my $dbh = C4::Context->dbh;
1570 SELECT datereceived, parent_ordernumber, quantity
1572 WHERE ordernumber = ?
1574 my $sth = $dbh->prepare($query);
1575 $sth->execute($ordernumber);
1576 my $order = $sth->fetchrow_hashref;
1578 warn "CancelReceipt: order $ordernumber does not exist";
1581 unless($order->{'datereceived'}) {
1582 warn "CancelReceipt: order $ordernumber is not received";
1586 my $parent_ordernumber = $order->{'parent_ordernumber'};
1588 my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1590 if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1591 # The order line has no parent, just mark it as not received
1594 SET quantityreceived = ?,
1597 orderstatus = 'ordered'
1598 WHERE ordernumber = ?
1600 $sth = $dbh->prepare($query);
1601 $sth->execute(0, undef, undef, $ordernumber);
1602 _cancel_items_receipt( $ordernumber );
1604 # The order line has a parent, increase parent quantity and delete
1607 SELECT quantity, datereceived
1609 WHERE ordernumber = ?
1611 $sth = $dbh->prepare($query);
1612 $sth->execute($parent_ordernumber);
1613 my $parent_order = $sth->fetchrow_hashref;
1614 unless($parent_order) {
1615 warn "Parent order $parent_ordernumber does not exist.";
1618 if($parent_order->{'datereceived'}) {
1619 warn "CancelReceipt: parent order is received.".
1620 " Can't cancel receipt.";
1626 orderstatus = 'ordered'
1627 WHERE ordernumber = ?
1629 $sth = $dbh->prepare($query);
1630 my $rv = $sth->execute(
1631 $order->{'quantity'} + $parent_order->{'quantity'},
1635 warn "Cannot update parent order line, so do not cancel".
1640 # Recalculate tax_value
1644 tax_value_on_ordering = quantity * ecost_tax_excluded * tax_rate_on_ordering,
1645 tax_value_on_receiving = quantity * unitprice_tax_excluded * tax_rate_on_receiving
1646 WHERE ordernumber = ?
1647 |, undef, $parent_ordernumber);
1649 _cancel_items_receipt( $ordernumber, $parent_ordernumber );
1652 DELETE FROM aqorders
1653 WHERE ordernumber = ?
1655 $sth = $dbh->prepare($query);
1656 $sth->execute($ordernumber);
1660 if(C4::Context->preference('AcqCreateItem') eq 'ordering') {
1661 my @affects = split q{\|}, C4::Context->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1663 for my $in ( @itemnumbers ) {
1664 my $item = Koha::Items->find( $in );
1665 my $biblio = $item->biblio;
1666 my ( $itemfield ) = GetMarcFromKohaField( 'items.itemnumber', $biblio->frameworkcode );
1667 my $item_marc = C4::Items::GetMarcItem( $biblio->biblionumber, $in );
1668 for my $affect ( @affects ) {
1669 my ( $sf, $v ) = split q{=}, $affect, 2;
1670 foreach ( $item_marc->field($itemfield) ) {
1671 $_->update( $sf => $v );
1674 C4::Items::ModItemFromMarc( $item_marc, $biblio->biblionumber, $in );
1679 return $parent_ordernumber;
1682 sub _cancel_items_receipt {
1683 my ( $ordernumber, $parent_ordernumber ) = @_;
1684 $parent_ordernumber ||= $ordernumber;
1686 my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1687 if(C4::Context->preference('AcqCreateItem') eq 'receiving') {
1688 # Remove items that were created at receipt
1690 DELETE FROM items, aqorders_items
1691 USING items, aqorders_items
1692 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1694 my $dbh = C4::Context->dbh;
1695 my $sth = $dbh->prepare($query);
1696 foreach my $itemnumber (@itemnumbers) {
1697 $sth->execute($itemnumber, $itemnumber);
1701 foreach my $itemnumber (@itemnumbers) {
1702 ModItemOrder($itemnumber, $parent_ordernumber);
1707 #------------------------------------------------------------#
1711 @results = &SearchOrders({
1712 ordernumber => $ordernumber,
1715 booksellerid => $booksellerid,
1716 basketno => $basketno,
1717 basketname => $basketname,
1718 basketgroupname => $basketgroupname,
1722 biblionumber => $biblionumber,
1723 budget_id => $budget_id
1726 Searches for orders filtered by criteria.
1728 C<$ordernumber> Finds matching orders or transferred orders by ordernumber.
1729 C<$search> Finds orders matching %$search% in title, author, or isbn.
1730 C<$owner> Finds order for the logged in user.
1731 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1732 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1735 C<@results> is an array of references-to-hash with the keys are fields
1736 from aqorders, biblio, biblioitems and aqbasket tables.
1741 my ( $params ) = @_;
1742 my $ordernumber = $params->{ordernumber};
1743 my $search = $params->{search};
1744 my $ean = $params->{ean};
1745 my $booksellerid = $params->{booksellerid};
1746 my $basketno = $params->{basketno};
1747 my $basketname = $params->{basketname};
1748 my $basketgroupname = $params->{basketgroupname};
1749 my $owner = $params->{owner};
1750 my $pending = $params->{pending};
1751 my $ordered = $params->{ordered};
1752 my $biblionumber = $params->{biblionumber};
1753 my $budget_id = $params->{budget_id};
1755 my $dbh = C4::Context->dbh;
1758 SELECT aqbasket.basketno,
1760 borrowers.firstname,
1763 biblioitems.biblioitemnumber,
1764 biblioitems.publishercode,
1765 biblioitems.publicationyear,
1766 aqbasket.authorisedby,
1767 aqbasket.booksellerid,
1769 aqbasket.creationdate,
1770 aqbasket.basketname,
1771 aqbasketgroups.id as basketgroupid,
1772 aqbasketgroups.name as basketgroupname,
1775 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1776 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1777 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1778 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1779 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1782 # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
1784 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1788 WHERE (datecancellationprinted is NULL)
1791 if ( $pending or $ordered ) {
1794 ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) )
1796 ( quantity > quantityreceived OR quantityreceived is NULL )
1800 $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1808 my $userenv = C4::Context->userenv;
1809 if ( C4::Context->preference("IndependentBranches") ) {
1810 unless ( C4::Context->IsSuperLibrarian() ) {
1813 borrowers.branchcode = ?
1814 OR borrowers.branchcode = ''
1817 push @args, $userenv->{branch};
1821 if ( $ordernumber ) {
1822 $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1823 push @args, ( $ordernumber, $ordernumber );
1825 if ( $biblionumber ) {
1826 $query .= 'AND aqorders.biblionumber = ?';
1827 push @args, $biblionumber;
1830 $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1831 push @args, ("%$search%","%$search%","%$search%");
1834 $query .= ' AND biblioitems.ean = ?';
1837 if ( $booksellerid ) {
1838 $query .= 'AND aqbasket.booksellerid = ?';
1839 push @args, $booksellerid;
1842 $query .= 'AND aqbasket.basketno = ?';
1843 push @args, $basketno;
1846 $query .= 'AND aqbasket.basketname LIKE ?';
1847 push @args, "%$basketname%";
1849 if( $basketgroupname ) {
1850 $query .= ' AND aqbasketgroups.name LIKE ?';
1851 push @args, "%$basketgroupname%";
1855 $query .= ' AND aqbasket.authorisedby=? ';
1856 push @args, $userenv->{'number'};
1860 $query .= ' AND aqorders.budget_id = ?';
1861 push @args, $budget_id;
1864 $query .= ' ORDER BY aqbasket.basketno';
1866 my $sth = $dbh->prepare($query);
1867 $sth->execute(@args);
1868 return $sth->fetchall_arrayref({});
1871 #------------------------------------------------------------#
1875 &DelOrder($biblionumber, $ordernumber);
1877 Cancel the order with the given order and biblio numbers. It does not
1878 delete any entries in the aqorders table, it merely marks them as
1884 my ( $bibnum, $ordernumber, $delete_biblio, $reason ) = @_;
1887 my $dbh = C4::Context->dbh;
1890 SET datecancellationprinted=now(), orderstatus='cancelled'
1893 $query .= ", cancellationreason = ? ";
1896 WHERE biblionumber=? AND ordernumber=?
1898 my $sth = $dbh->prepare($query);
1900 $sth->execute($reason, $bibnum, $ordernumber);
1902 $sth->execute( $bibnum, $ordernumber );
1906 my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1907 foreach my $itemnumber (@itemnumbers){
1908 my $delcheck = C4::Items::DelItemCheck( $bibnum, $itemnumber );
1910 if($delcheck != 1) {
1911 $error->{'delitem'} = 1;
1915 if($delete_biblio) {
1916 # We get the number of remaining items
1917 my $biblio = Koha::Biblios->find( $bibnum );
1918 my $itemcount = $biblio->items->count;
1920 # If there are no items left,
1921 if ( $itemcount == 0 ) {
1922 # We delete the record
1923 my $delcheck = DelBiblio($bibnum);
1926 $error->{'delbiblio'} = 1;
1934 =head3 TransferOrder
1936 my $newordernumber = TransferOrder($ordernumber, $basketno);
1938 Transfer an order line to a basket.
1939 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1940 to BOOKSELLER on DATE' and create new order with internal note
1941 'Transferred from BOOKSELLER on DATE'.
1942 Move all attached items to the new order.
1943 Received orders cannot be transferred.
1944 Return the ordernumber of created order.
1949 my ($ordernumber, $basketno) = @_;
1951 return unless ($ordernumber and $basketno);
1953 my $order = GetOrder( $ordernumber );
1954 return if $order->{datereceived};
1955 my $basket = GetBasket($basketno);
1956 return unless $basket;
1958 my $dbh = C4::Context->dbh;
1959 my ($query, $sth, $rv);
1963 SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1964 WHERE ordernumber = ?
1966 $sth = $dbh->prepare($query);
1967 $rv = $sth->execute('cancelled', $ordernumber);
1969 delete $order->{'ordernumber'};
1970 delete $order->{parent_ordernumber};
1971 $order->{'basketno'} = $basketno;
1973 my $newordernumber = Koha::Acquisition::Order->new($order)->insert->{ordernumber};
1976 UPDATE aqorders_items
1978 WHERE ordernumber = ?
1980 $sth = $dbh->prepare($query);
1981 $sth->execute($newordernumber, $ordernumber);
1984 INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1987 $sth = $dbh->prepare($query);
1988 $sth->execute($ordernumber, $newordernumber);
1990 return $newordernumber;
1993 =head2 FUNCTIONS ABOUT PARCELS
1997 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1999 get a lists of parcels.
2006 is the bookseller this function has to get parcels.
2009 To know on what criteria the results list has to be ordered.
2012 is the booksellerinvoicenumber.
2014 =item $datefrom & $dateto
2015 to know on what date this function has to filter its search.
2020 a pointer on a hash list containing parcel informations as such :
2026 =item Last operation
2028 =item Number of biblio
2030 =item Number of items
2037 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
2038 my $dbh = C4::Context->dbh;
2039 my @query_params = ();
2041 SELECT aqinvoices.invoicenumber,
2042 datereceived,purchaseordernumber,
2043 count(DISTINCT biblionumber) AS biblio,
2044 sum(quantity) AS itemsexpected,
2045 sum(quantityreceived) AS itemsreceived
2046 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
2047 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2048 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
2050 push @query_params, $bookseller;
2052 if ( defined $code ) {
2053 $strsth .= ' and aqinvoices.invoicenumber like ? ';
2054 # add a % to the end of the code to allow stemming.
2055 push @query_params, "$code%";
2058 if ( defined $datefrom ) {
2059 $strsth .= ' and datereceived >= ? ';
2060 push @query_params, $datefrom;
2063 if ( defined $dateto ) {
2064 $strsth .= 'and datereceived <= ? ';
2065 push @query_params, $dateto;
2068 $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
2070 # can't use a placeholder to place this column name.
2071 # but, we could probably be checking to make sure it is a column that will be fetched.
2072 $strsth .= "order by $order " if ($order);
2074 my $sth = $dbh->prepare($strsth);
2076 $sth->execute( @query_params );
2077 my $results = $sth->fetchall_arrayref({});
2081 #------------------------------------------------------------#
2083 =head3 GetLateOrders
2085 @results = &GetLateOrders;
2087 Searches for bookseller with late orders.
2090 the table of supplier with late issues. This table is full of hashref.
2096 my $supplierid = shift;
2098 my $estimateddeliverydatefrom = shift;
2099 my $estimateddeliverydateto = shift;
2101 my $dbh = C4::Context->dbh;
2103 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
2104 my $dbdriver = C4::Context->config("db_scheme") || "mysql";
2106 my @query_params = ();
2108 SELECT aqbasket.basketno,
2109 aqorders.ordernumber,
2110 DATE(aqbasket.closedate) AS orderdate,
2111 aqbasket.basketname AS basketname,
2112 aqbasket.basketgroupid AS basketgroupid,
2113 aqbasketgroups.name AS basketgroupname,
2114 aqorders.rrp AS unitpricesupplier,
2115 aqorders.ecost AS unitpricelib,
2116 aqorders.claims_count AS claims_count,
2117 aqorders.claimed_date AS claimed_date,
2118 aqbudgets.budget_name AS budget,
2119 borrowers.branchcode AS branch,
2120 aqbooksellers.name AS supplier,
2121 aqbooksellers.id AS supplierid,
2122 biblio.author, biblio.title,
2123 biblioitems.publishercode AS publisher,
2124 biblioitems.publicationyear,
2125 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
2129 aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
2130 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
2131 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
2132 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
2133 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
2134 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2135 WHERE aqorders.basketno = aqbasket.basketno
2136 AND ( datereceived = ''
2137 OR datereceived IS NULL
2138 OR aqorders.quantityreceived < aqorders.quantity
2140 AND aqbasket.closedate IS NOT NULL
2141 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
2144 if ($dbdriver eq "mysql") {
2146 aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity,
2147 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
2148 DATEDIFF(CAST(now() AS date),closedate) AS latesince
2150 if ( defined $delay ) {
2151 $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
2152 push @query_params, $delay;
2154 $having = "HAVING quantity <> 0";
2156 # FIXME: account for IFNULL as above
2158 aqorders.quantity AS quantity,
2159 aqorders.quantity * aqorders.rrp AS subtotal,
2160 (CAST(now() AS date) - closedate) AS latesince
2162 if ( defined $delay ) {
2163 $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
2164 push @query_params, $delay;
2167 if (defined $supplierid) {
2168 $from .= ' AND aqbasket.booksellerid = ? ';
2169 push @query_params, $supplierid;
2171 if (defined $branch) {
2172 $from .= ' AND borrowers.branchcode LIKE ? ';
2173 push @query_params, $branch;
2176 if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
2177 $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
2179 if ( defined $estimateddeliverydatefrom ) {
2180 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
2181 push @query_params, $estimateddeliverydatefrom;
2183 if ( defined $estimateddeliverydateto ) {
2184 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
2185 push @query_params, $estimateddeliverydateto;
2187 if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
2188 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
2190 if (C4::Context->preference("IndependentBranches")
2191 && !C4::Context->IsSuperLibrarian() ) {
2192 $from .= ' AND borrowers.branchcode LIKE ? ';
2193 push @query_params, C4::Context->userenv->{branch};
2195 $from .= " AND orderstatus <> 'cancelled' ";
2196 my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
2197 $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
2198 my $sth = $dbh->prepare($query);
2199 $sth->execute(@query_params);
2201 while (my $data = $sth->fetchrow_hashref) {
2202 push @results, $data;
2207 #------------------------------------------------------------#
2211 \@order_loop = GetHistory( %params );
2213 Retreives some acquisition history information
2223 basket - search both basket name and number
2224 booksellerinvoicenumber
2227 orderstatus (note that orderstatus '' will retrieve orders
2228 of any status except cancelled)
2230 get_canceled_order (if set to a true value, cancelled orders will
2234 $order_loop is a list of hashrefs that each look like this:
2236 'author' => 'Twain, Mark',
2238 'biblionumber' => '215',
2240 'creationdate' => 'MM/DD/YYYY',
2241 'datereceived' => undef,
2244 'invoicenumber' => undef,
2246 'ordernumber' => '1',
2248 'quantityreceived' => undef,
2249 'title' => 'The Adventures of Huckleberry Finn'
2255 # don't run the query if there are no parameters (list would be too long for sure !)
2256 croak "No search params" unless @_;
2258 my $title = $params{title};
2259 my $author = $params{author};
2260 my $isbn = $params{isbn};
2261 my $ean = $params{ean};
2262 my $name = $params{name};
2263 my $from_placed_on = $params{from_placed_on};
2264 my $to_placed_on = $params{to_placed_on};
2265 my $basket = $params{basket};
2266 my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2267 my $basketgroupname = $params{basketgroupname};
2268 my $budget = $params{budget};
2269 my $orderstatus = $params{orderstatus};
2270 my $biblionumber = $params{biblionumber};
2271 my $get_canceled_order = $params{get_canceled_order} || 0;
2272 my $ordernumber = $params{ordernumber};
2273 my $search_children_too = $params{search_children_too} || 0;
2274 my $created_by = $params{created_by} || [];
2278 my $total_qtyreceived = 0;
2279 my $total_price = 0;
2281 my $dbh = C4::Context->dbh;
2284 COALESCE(biblio.title, deletedbiblio.title) AS title,
2285 COALESCE(biblio.author, deletedbiblio.author) AS author,
2286 COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2287 COALESCE(biblioitems.ean, deletedbiblioitems.ean) AS ean,
2289 aqbasket.basketname,
2290 aqbasket.basketgroupid,
2291 aqbasket.authorisedby,
2292 concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2293 aqbasketgroups.name as groupname,
2295 aqbasket.creationdate,
2296 aqorders.datereceived,
2298 aqorders.quantityreceived,
2300 aqorders.ordernumber,
2302 aqinvoices.invoicenumber,
2303 aqbooksellers.id as id,
2304 aqorders.biblionumber,
2305 aqorders.orderstatus,
2306 aqorders.parent_ordernumber,
2307 aqbudgets.budget_name
2309 $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2312 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2313 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2314 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2315 LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2316 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2317 LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2318 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2319 LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2320 LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2321 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2324 $query .= " WHERE 1 ";
2326 unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2327 $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2330 my @query_params = ();
2332 if ( $biblionumber ) {
2333 $query .= " AND biblio.biblionumber = ?";
2334 push @query_params, $biblionumber;
2338 $query .= " AND biblio.title LIKE ? ";
2339 $title =~ s/\s+/%/g;
2340 push @query_params, "%$title%";
2344 $query .= " AND biblio.author LIKE ? ";
2345 push @query_params, "%$author%";
2349 $query .= " AND biblioitems.isbn LIKE ? ";
2350 push @query_params, "%$isbn%";
2353 $query .= " AND biblioitems.ean = ? ";
2354 push @query_params, "$ean";
2357 $query .= " AND aqbooksellers.name LIKE ? ";
2358 push @query_params, "%$name%";
2362 $query .= " AND aqbudgets.budget_id = ? ";
2363 push @query_params, "$budget";
2366 if ( $from_placed_on ) {
2367 $query .= " AND creationdate >= ? ";
2368 push @query_params, $from_placed_on;
2371 if ( $to_placed_on ) {
2372 $query .= " AND creationdate <= ? ";
2373 push @query_params, $to_placed_on;
2376 if ( defined $orderstatus and $orderstatus ne '') {
2377 $query .= " AND aqorders.orderstatus = ? ";
2378 push @query_params, "$orderstatus";
2382 if ($basket =~ m/^\d+$/) {
2383 $query .= " AND aqorders.basketno = ? ";
2384 push @query_params, $basket;
2386 $query .= " AND aqbasket.basketname LIKE ? ";
2387 push @query_params, "%$basket%";
2391 if ($booksellerinvoicenumber) {
2392 $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2393 push @query_params, "%$booksellerinvoicenumber%";
2396 if ($basketgroupname) {
2397 $query .= " AND aqbasketgroups.name LIKE ? ";
2398 push @query_params, "%$basketgroupname%";
2402 $query .= " AND (aqorders.ordernumber = ? ";
2403 push @query_params, $ordernumber;
2404 if ($search_children_too) {
2405 $query .= " OR aqorders.parent_ordernumber = ? ";
2406 push @query_params, $ordernumber;
2411 if ( @$created_by ) {
2412 $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2413 push @query_params, @$created_by;
2417 if ( C4::Context->preference("IndependentBranches") ) {
2418 unless ( C4::Context->IsSuperLibrarian() ) {
2419 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2420 push @query_params, C4::Context->userenv->{branch};
2423 $query .= " ORDER BY id";
2425 return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2428 =head2 GetRecentAcqui
2430 $results = GetRecentAcqui($days);
2432 C<$results> is a ref to a table which containts hashref
2436 sub GetRecentAcqui {
2438 my $dbh = C4::Context->dbh;
2442 ORDER BY timestamp DESC
2445 my $sth = $dbh->prepare($query);
2447 my $results = $sth->fetchall_arrayref({});
2451 #------------------------------------------------------------#
2455 &AddClaim($ordernumber);
2457 Add a claim for an order
2462 my ($ordernumber) = @_;
2463 my $dbh = C4::Context->dbh;
2466 claims_count = claims_count + 1,
2467 claimed_date = CURDATE()
2468 WHERE ordernumber = ?
2470 my $sth = $dbh->prepare($query);
2471 $sth->execute($ordernumber);
2476 my @invoices = GetInvoices(
2477 invoicenumber => $invoicenumber,
2478 supplierid => $supplierid,
2479 suppliername => $suppliername,
2480 shipmentdatefrom => $shipmentdatefrom, # ISO format
2481 shipmentdateto => $shipmentdateto, # ISO format
2482 billingdatefrom => $billingdatefrom, # ISO format
2483 billingdateto => $billingdateto, # ISO format
2484 isbneanissn => $isbn_or_ean_or_issn,
2487 publisher => $publisher,
2488 publicationyear => $publicationyear,
2489 branchcode => $branchcode,
2490 order_by => $order_by
2493 Return a list of invoices that match all given criteria.
2495 $order_by is "column_name (asc|desc)", where column_name is any of
2496 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2497 'shipmentcost', 'shipmentcost_budgetid'.
2499 asc is the default if omitted
2506 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2507 closedate shipmentcost shipmentcost_budgetid);
2509 my $dbh = C4::Context->dbh;
2511 SELECT aqinvoices.*, aqbooksellers.name AS suppliername,
2514 aqorders.datereceived IS NOT NULL,
2515 aqorders.biblionumber,
2518 ) AS receivedbiblios,
2521 aqorders.subscriptionid IS NOT NULL,
2522 aqorders.subscriptionid,
2525 ) AS is_linked_to_subscriptions,
2526 SUM(aqorders.quantityreceived) AS receiveditems
2528 LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2529 LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2530 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2531 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2532 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2533 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2534 LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2539 if($args{supplierid}) {
2540 push @bind_strs, " aqinvoices.booksellerid = ? ";
2541 push @bind_args, $args{supplierid};
2543 if($args{invoicenumber}) {
2544 push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2545 push @bind_args, "%$args{invoicenumber}%";
2547 if($args{suppliername}) {
2548 push @bind_strs, " aqbooksellers.name LIKE ? ";
2549 push @bind_args, "%$args{suppliername}%";
2551 if($args{shipmentdatefrom}) {
2552 push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2553 push @bind_args, $args{shipmentdatefrom};
2555 if($args{shipmentdateto}) {
2556 push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2557 push @bind_args, $args{shipmentdateto};
2559 if($args{billingdatefrom}) {
2560 push @bind_strs, " aqinvoices.billingdate >= ? ";
2561 push @bind_args, $args{billingdatefrom};
2563 if($args{billingdateto}) {
2564 push @bind_strs, " aqinvoices.billingdate <= ? ";
2565 push @bind_args, $args{billingdateto};
2567 if($args{isbneanissn}) {
2568 push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2569 push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2572 push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2573 push @bind_args, $args{title};
2576 push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2577 push @bind_args, $args{author};
2579 if($args{publisher}) {
2580 push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2581 push @bind_args, $args{publisher};
2583 if($args{publicationyear}) {
2584 push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2585 push @bind_args, $args{publicationyear}, $args{publicationyear};
2587 if($args{branchcode}) {
2588 push @bind_strs, " borrowers.branchcode = ? ";
2589 push @bind_args, $args{branchcode};
2591 if($args{message_id}) {
2592 push @bind_strs, " aqinvoices.message_id = ? ";
2593 push @bind_args, $args{message_id};
2596 $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2597 $query .= " GROUP BY aqinvoices.invoiceid ";
2599 if($args{order_by}) {
2600 my ($column, $direction) = split / /, $args{order_by};
2601 if(grep /^$column$/, @columns) {
2602 $direction ||= 'ASC';
2603 $query .= " ORDER BY $column $direction";
2607 my $sth = $dbh->prepare($query);
2608 $sth->execute(@bind_args);
2610 my $results = $sth->fetchall_arrayref({});
2616 my $invoice = GetInvoice($invoiceid);
2618 Get informations about invoice with given $invoiceid
2620 Return a hash filled with aqinvoices.* fields
2625 my ($invoiceid) = @_;
2628 return unless $invoiceid;
2630 my $dbh = C4::Context->dbh;
2636 my $sth = $dbh->prepare($query);
2637 $sth->execute($invoiceid);
2639 $invoice = $sth->fetchrow_hashref;
2643 =head3 GetInvoiceDetails
2645 my $invoice = GetInvoiceDetails($invoiceid)
2647 Return informations about an invoice + the list of related order lines
2649 Orders informations are in $invoice->{orders} (array ref)
2653 sub GetInvoiceDetails {
2654 my ($invoiceid) = @_;
2656 if ( !defined $invoiceid ) {
2657 carp 'GetInvoiceDetails called without an invoiceid';
2661 my $dbh = C4::Context->dbh;
2663 SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2665 LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2668 my $sth = $dbh->prepare($query);
2669 $sth->execute($invoiceid);
2671 my $invoice = $sth->fetchrow_hashref;
2676 biblio.copyrightdate,
2678 biblioitems.publishercode,
2679 biblioitems.publicationyear,
2680 aqbasket.basketname,
2681 aqbasketgroups.id AS basketgroupid,
2682 aqbasketgroups.name AS basketgroupname
2684 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2685 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2686 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2687 LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2690 $sth = $dbh->prepare($query);
2691 $sth->execute($invoiceid);
2692 $invoice->{orders} = $sth->fetchall_arrayref({});
2693 $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2700 my $invoiceid = AddInvoice(
2701 invoicenumber => $invoicenumber,
2702 booksellerid => $booksellerid,
2703 shipmentdate => $shipmentdate,
2704 billingdate => $billingdate,
2705 closedate => $closedate,
2706 shipmentcost => $shipmentcost,
2707 shipmentcost_budgetid => $shipmentcost_budgetid
2710 Create a new invoice and return its id or undef if it fails.
2717 return unless(%invoice and $invoice{invoicenumber});
2719 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2720 closedate shipmentcost shipmentcost_budgetid message_id);
2724 foreach my $key (keys %invoice) {
2725 if(0 < grep(/^$key$/, @columns)) {
2726 push @set_strs, "$key = ?";
2727 push @set_args, ($invoice{$key} || undef);
2733 my $dbh = C4::Context->dbh;
2734 my $query = "INSERT INTO aqinvoices SET ";
2735 $query .= join (",", @set_strs);
2736 my $sth = $dbh->prepare($query);
2737 $rv = $sth->execute(@set_args);
2739 $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2748 invoiceid => $invoiceid, # Mandatory
2749 invoicenumber => $invoicenumber,
2750 booksellerid => $booksellerid,
2751 shipmentdate => $shipmentdate,
2752 billingdate => $billingdate,
2753 closedate => $closedate,
2754 shipmentcost => $shipmentcost,
2755 shipmentcost_budgetid => $shipmentcost_budgetid
2758 Modify an invoice, invoiceid is mandatory.
2760 Return undef if it fails.
2767 return unless(%invoice and $invoice{invoiceid});
2769 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2770 closedate shipmentcost shipmentcost_budgetid);
2774 foreach my $key (keys %invoice) {
2775 if(0 < grep(/^$key$/, @columns)) {
2776 push @set_strs, "$key = ?";
2777 push @set_args, ($invoice{$key} || undef);
2781 my $dbh = C4::Context->dbh;
2782 my $query = "UPDATE aqinvoices SET ";
2783 $query .= join(",", @set_strs);
2784 $query .= " WHERE invoiceid = ?";
2786 my $sth = $dbh->prepare($query);
2787 $sth->execute(@set_args, $invoice{invoiceid});
2792 CloseInvoice($invoiceid);
2796 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2801 my ($invoiceid) = @_;
2803 return unless $invoiceid;
2805 my $dbh = C4::Context->dbh;
2808 SET closedate = CAST(NOW() AS DATE)
2811 my $sth = $dbh->prepare($query);
2812 $sth->execute($invoiceid);
2815 =head3 ReopenInvoice
2817 ReopenInvoice($invoiceid);
2821 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2826 my ($invoiceid) = @_;
2828 return unless $invoiceid;
2830 my $dbh = C4::Context->dbh;
2833 SET closedate = NULL
2836 my $sth = $dbh->prepare($query);
2837 $sth->execute($invoiceid);
2842 DelInvoice($invoiceid);
2844 Delete an invoice if there are no items attached to it.
2849 my ($invoiceid) = @_;
2851 return unless $invoiceid;
2853 my $dbh = C4::Context->dbh;
2859 my $sth = $dbh->prepare($query);
2860 $sth->execute($invoiceid);
2861 my $res = $sth->fetchrow_arrayref;
2862 if ( $res && $res->[0] == 0 ) {
2864 DELETE FROM aqinvoices
2867 my $sth = $dbh->prepare($query);
2868 return ( $sth->execute($invoiceid) > 0 );
2873 =head3 MergeInvoices
2875 MergeInvoices($invoiceid, \@sourceids);
2877 Merge the invoices identified by the IDs in \@sourceids into
2878 the invoice identified by $invoiceid.
2883 my ($invoiceid, $sourceids) = @_;
2885 return unless $invoiceid;
2886 foreach my $sourceid (@$sourceids) {
2887 next if $sourceid == $invoiceid;
2888 my $source = GetInvoiceDetails($sourceid);
2889 foreach my $order (@{$source->{'orders'}}) {
2890 $order->{'invoiceid'} = $invoiceid;
2893 DelInvoice($source->{'invoiceid'});
2898 =head3 GetBiblioCountByBasketno
2900 $biblio_count = &GetBiblioCountByBasketno($basketno);
2902 Looks up the biblio's count that has basketno value $basketno
2908 sub GetBiblioCountByBasketno {
2909 my ($basketno) = @_;
2910 my $dbh = C4::Context->dbh;
2912 SELECT COUNT( DISTINCT( biblionumber ) )
2915 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
2918 my $sth = $dbh->prepare($query);
2919 $sth->execute($basketno);
2920 return $sth->fetchrow;
2923 # Note this subroutine should be moved to Koha::Acquisition::Order
2924 # Will do when a DBIC decision will be taken.
2925 sub populate_order_with_prices {
2928 my $order = $params->{order};
2929 my $booksellerid = $params->{booksellerid};
2930 return unless $booksellerid;
2932 my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
2934 my $receiving = $params->{receiving};
2935 my $ordering = $params->{ordering};
2936 my $discount = $order->{discount};
2937 $discount /= 100 if $discount > 1;
2940 $order->{tax_rate_on_ordering} //= $order->{tax_rate};
2941 if ( $bookseller->listincgst ) {
2942 # The user entered the rrp tax included
2943 $order->{rrp_tax_included} = $order->{rrp};
2945 # rrp tax excluded = rrp tax included / ( 1 + tax rate )
2946 $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2948 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2949 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2951 # ecost tax included = rrp tax included ( 1 - discount )
2952 $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
2955 # The user entered the rrp tax excluded
2956 $order->{rrp_tax_excluded} = $order->{rrp};
2958 # rrp tax included = rrp tax excluded * ( 1 - tax rate )
2959 $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2961 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2962 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2964 # ecost tax included = rrp tax excluded * ( 1 - tax rate ) * ( 1 - discount )
2965 $order->{ecost_tax_included} =
2966 $order->{rrp_tax_excluded} *
2967 ( 1 + $order->{tax_rate_on_ordering} ) *
2971 # tax value = quantity * ecost tax excluded * tax rate
2972 $order->{tax_value_on_ordering} =
2973 $order->{quantity} * $order->{ecost_tax_excluded} * $order->{tax_rate_on_ordering};
2977 $order->{tax_rate_on_receiving} //= $order->{tax_rate};
2978 if ( $bookseller->invoiceincgst ) {
2979 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2980 # we need to keep the exact ecost value
2981 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
2982 $order->{unitprice} = $order->{ecost_tax_included};
2985 # The user entered the unit price tax included
2986 $order->{unitprice_tax_included} = $order->{unitprice};
2988 # unit price tax excluded = unit price tax included / ( 1 + tax rate )
2989 $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
2992 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2993 # we need to keep the exact ecost value
2994 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
2995 $order->{unitprice} = $order->{ecost_tax_excluded};
2998 # The user entered the unit price tax excluded
2999 $order->{unitprice_tax_excluded} = $order->{unitprice};
3002 # unit price tax included = unit price tax included * ( 1 + tax rate )
3003 $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
3006 # tax value = quantity * unit price tax excluded * tax rate
3007 $order->{tax_value_on_receiving} = $order->{quantity} * $order->{unitprice_tax_excluded} * $order->{tax_rate_on_receiving};
3013 =head3 GetOrderUsers
3015 $order_users_ids = &GetOrderUsers($ordernumber);
3017 Returns a list of all borrowernumbers that are in order users list
3022 my ($ordernumber) = @_;
3024 return unless $ordernumber;
3027 SELECT borrowernumber
3029 WHERE ordernumber = ?
3031 my $dbh = C4::Context->dbh;
3032 my $sth = $dbh->prepare($query);
3033 $sth->execute($ordernumber);
3034 my $results = $sth->fetchall_arrayref( {} );
3036 my @borrowernumbers;
3037 foreach (@$results) {
3038 push @borrowernumbers, $_->{'borrowernumber'};
3041 return @borrowernumbers;
3044 =head3 ModOrderUsers
3046 my @order_users_ids = (1, 2, 3);
3047 &ModOrderUsers($ordernumber, @basketusers_ids);
3049 Delete all users from order users list, and add users in C<@order_users_ids>
3055 my ( $ordernumber, @order_users_ids ) = @_;
3057 return unless $ordernumber;
3059 my $dbh = C4::Context->dbh;
3061 DELETE FROM aqorder_users
3062 WHERE ordernumber = ?
3064 my $sth = $dbh->prepare($query);
3065 $sth->execute($ordernumber);
3068 INSERT INTO aqorder_users (ordernumber, borrowernumber)
3071 $sth = $dbh->prepare($query);
3072 foreach my $order_user_id (@order_users_ids) {
3073 $sth->execute( $ordernumber, $order_user_id );
3077 sub NotifyOrderUsers {
3078 my ($ordernumber) = @_;
3080 my @borrowernumbers = GetOrderUsers($ordernumber);
3081 return unless @borrowernumbers;
3083 my $order = GetOrder( $ordernumber );
3084 for my $borrowernumber (@borrowernumbers) {
3085 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
3086 my $library = Koha::Libraries->find( $borrower->{branchcode} )->unblessed;
3087 my $biblio = C4::Biblio::GetBiblio( $order->{biblionumber} );
3088 my $letter = C4::Letters::GetPreparedLetter(
3089 module => 'acquisition',
3090 letter_code => 'ACQ_NOTIF_ON_RECEIV',
3091 branchcode => $library->{branchcode},
3092 lang => $borrower->{lang},
3094 'branches' => $library,
3095 'borrowers' => $borrower,
3096 'biblio' => $biblio,
3097 'aqorders' => $order,
3101 C4::Letters::EnqueueLetter(
3104 borrowernumber => $borrowernumber,
3105 LibraryName => C4::Context->preference("LibraryName"),
3106 message_transport_type => 'email',
3108 ) or warn "can't enqueue letter $letter";
3113 =head3 FillWithDefaultValues
3115 FillWithDefaultValues( $marc_record );
3117 This will update the record with default value defined in the ACQ framework.
3118 For all existing fields, if a default value exists and there are no subfield, it will be created.
3119 If the field does not exist, it will be created too.
3123 sub FillWithDefaultValues {
3125 my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3128 C4::Biblio::GetMarcFromKohaField( 'items.itemnumber', '' );
3129 for my $tag ( sort keys %$tagslib ) {
3131 next if $tag == $itemfield;
3132 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3133 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3134 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3135 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3136 my @fields = $record->field($tag);
3138 for my $field (@fields) {
3139 unless ( defined $field->subfield($subfield) ) {
3140 $field->add_subfields(
3141 $subfield => $defaultvalue );
3146 $record->insert_fields_ordered(
3148 $tag, '', '', $subfield => $defaultvalue
3163 Koha Development Team <http://koha-community.org/>