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::Booksellers;
32 use Koha::Acquisition::Orders;
36 use Koha::Number::Price;
38 use Koha::CsvProfiles;
48 use vars qw(@ISA @EXPORT);
54 &GetBasket &NewBasket &CloseBasket &ReopenBasket &DelBasket &ModBasket
55 &GetBasketAsCSV &GetBasketGroupAsCSV
56 &GetBasketsByBookseller &GetBasketsByBasketgroup
57 &GetBasketsInfosByBookseller
59 &GetBasketUsers &ModBasketUsers
64 &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup
65 &GetBasketgroups &ReOpenBasketgroup
67 &DelOrder &ModOrder &GetOrder &GetOrders &GetOrdersByBiblionumber
68 &GetLateOrders &GetOrderFromItemnumber
69 &SearchOrders &GetHistory &GetRecentAcqui
70 &ModReceiveOrder &CancelReceipt
72 &GetLastOrderNotReceivedFromSubscriptionid &GetLastOrderReceivedFromSubscriptionid
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;
124 C4::Acquisition - Koha functions for dealing with orders and acquisitions
132 The functions in this module deal with acquisitions, managing book
133 orders, basket and parcels.
137 =head2 FUNCTIONS ABOUT BASKETS
141 $aqbasket = &GetBasket($basketnumber);
143 get all basket informations in aqbasket for a given basket
145 B<returns:> informations for a given basket returned as a hashref.
151 my $dbh = C4::Context->dbh;
154 concat( b.firstname,' ',b.surname) AS authorisedbyname
156 LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
159 my $sth=$dbh->prepare($query);
160 $sth->execute($basketno);
161 my $basket = $sth->fetchrow_hashref;
165 #------------------------------------------------------------#
169 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
170 $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace, $is_standing, $create_items );
172 Create a new basket in aqbasket table
176 =item C<$booksellerid> is a foreign key in the aqbasket table
178 =item C<$authorizedby> is the username of who created the basket
182 The other parameters are optional, see ModBasketHeader for more info on them.
187 my ( $booksellerid, $authorisedby, $basketname, $basketnote,
188 $basketbooksellernote, $basketcontractnumber, $deliveryplace,
189 $billingplace, $is_standing, $create_items ) = @_;
190 my $dbh = C4::Context->dbh;
192 'INSERT INTO aqbasket (creationdate,booksellerid,authorisedby) '
193 . 'VALUES (now(),?,?)';
194 $dbh->do( $query, {}, $booksellerid, $authorisedby );
196 my $basket = $dbh->{mysql_insertid};
197 $basketname ||= q{}; # default to empty strings
199 $basketbooksellernote ||= q{};
200 ModBasketHeader( $basket, $basketname, $basketnote, $basketbooksellernote,
201 $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items );
205 #------------------------------------------------------------#
209 &CloseBasket($basketno);
211 close a basket (becomes unmodifiable, except for receives)
217 my $dbh = C4::Context->dbh;
218 $dbh->do('UPDATE aqbasket SET closedate=now() WHERE basketno=?', {}, $basketno );
221 q{UPDATE aqorders SET orderstatus = 'ordered' WHERE basketno = ? AND orderstatus NOT IN ( 'complete', 'cancelled')},
229 &ReopenBasket($basketno);
237 my $dbh = C4::Context->dbh;
238 $dbh->do( q{UPDATE aqbasket SET closedate=NULL WHERE basketno=?}, {}, $basketno );
242 SET orderstatus = 'new'
244 AND orderstatus NOT IN ( 'complete', 'cancelled' )
249 #------------------------------------------------------------#
251 =head3 GetBasketAsCSV
253 &GetBasketAsCSV($basketno);
255 Export a basket as CSV
257 $cgi parameter is needed for column name translation
262 my ($basketno, $cgi, $csv_profile_id) = @_;
263 my $basket = GetBasket($basketno);
264 my @orders = GetOrders($basketno);
265 my $contract = GetContract({
266 contractnumber => $basket->{'contractnumber'}
269 my $template = C4::Templates::gettemplate("acqui/csv/basket.tt", "intranet", $cgi);
271 if ($csv_profile_id) {
272 my $csv_profile = Koha::CsvProfiles->find( $csv_profile_id );
273 Koha::Exceptions::ObjectNotFound->throw( 'There is no valid csv profile given') unless $csv_profile;
275 my $csv = Text::CSV_XS->new({'quote_char'=>'"','escape_char'=>'"','sep_char'=>$csv_profile->csv_separator,'binary'=>1});
276 my $csv_profile_content = $csv_profile->content;
277 my ( @headers, @fields );
278 while ( $csv_profile_content =~ /
281 ([^\|]*) # fieldname (table.row or row)
285 my $field = ($2 eq '') ? $1 : $2;
287 $header =~ s/^\s+|\s+$//g; # Trim whitespaces
288 push @headers, $header;
290 $field =~ s/[^\.]*\.{1}//; # Remove the table name if exists.
291 $field =~ s/^\s+|\s+$//g; # Trim whitespaces
292 push @fields, $field;
294 for my $order (@orders) {
296 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
297 my $biblioitem = $biblio->biblioitem;
298 $order = { %$order, %{ $biblioitem->unblessed } };
300 $order = {%$order, %$contract};
302 $order = {%$order, %$basket, %{ $biblio->unblessed }};
303 for my $field (@fields) {
304 push @row, $order->{$field};
308 my $content = join( $csv_profile->csv_separator, @headers ) . "\n";
309 for my $row ( @rows ) {
310 $csv->combine(@$row);
311 my $string = $csv->string;
312 $content .= $string . "\n";
317 foreach my $order (@orders) {
318 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
319 my $biblioitem = $biblio->biblioitem;
321 contractname => $contract->{'contractname'},
322 ordernumber => $order->{'ordernumber'},
323 entrydate => $order->{'entrydate'},
324 isbn => $order->{'isbn'},
325 author => $biblio->author,
326 title => $biblio->title,
327 publicationyear => $biblioitem->publicationyear,
328 publishercode => $biblioitem->publishercode,
329 collectiontitle => $biblioitem->collectiontitle,
330 notes => $order->{'order_vendornote'},
331 quantity => $order->{'quantity'},
332 rrp => $order->{'rrp'},
334 for my $place ( qw( deliveryplace billingplace ) ) {
335 if ( my $library = Koha::Libraries->find( $row->{deliveryplace} ) ) {
336 $row->{$place} = $library->branchname
340 contractname author title publishercode collectiontitle notes
341 deliveryplace billingplace
343 # Double the quotes to not be interpreted as a field end
344 $row->{$_} =~ s/"/""/g if $row->{$_};
350 if(defined $a->{publishercode} and defined $b->{publishercode}) {
351 $a->{publishercode} cmp $b->{publishercode};
355 $template->param(rows => \@rows);
357 return $template->output;
362 =head3 GetBasketGroupAsCSV
364 &GetBasketGroupAsCSV($basketgroupid);
366 Export a basket group as CSV
368 $cgi parameter is needed for column name translation
372 sub GetBasketGroupAsCSV {
373 my ($basketgroupid, $cgi) = @_;
374 my $baskets = GetBasketsByBasketgroup($basketgroupid);
376 my $template = C4::Templates::gettemplate('acqui/csv/basketgroup.tt', 'intranet', $cgi);
379 for my $basket (@$baskets) {
380 my @orders = GetOrders( $basket->{basketno} );
381 my $contract = GetContract({
382 contractnumber => $basket->{contractnumber}
384 my $bookseller = Koha::Acquisition::Booksellers->find( $basket->{booksellerid} );
385 my $basketgroup = GetBasketgroup( $$basket{basketgroupid} );
387 foreach my $order (@orders) {
388 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
389 my $biblioitem = $biblio->biblioitem;
391 clientnumber => $bookseller->accountnumber,
392 basketname => $basket->{basketname},
393 ordernumber => $order->{ordernumber},
394 author => $biblio->author,
395 title => $biblio->title,
396 publishercode => $biblioitem->publishercode,
397 publicationyear => $biblioitem->publicationyear,
398 collectiontitle => $biblioitem->collectiontitle,
399 isbn => $order->{isbn},
400 quantity => $order->{quantity},
401 rrp_tax_included => $order->{rrp_tax_included},
402 rrp_tax_excluded => $order->{rrp_tax_excluded},
403 discount => $bookseller->discount,
404 ecost_tax_included => $order->{ecost_tax_included},
405 ecost_tax_excluded => $order->{ecost_tax_excluded},
406 notes => $order->{order_vendornote},
407 entrydate => $order->{entrydate},
408 booksellername => $bookseller->name,
409 bookselleraddress => $bookseller->address1,
410 booksellerpostal => $bookseller->postal,
411 contractnumber => $contract->{contractnumber},
412 contractname => $contract->{contractname},
415 basketgroupdeliveryplace => $basketgroup->{deliveryplace},
416 basketgroupbillingplace => $basketgroup->{billingplace},
417 basketdeliveryplace => $basket->{deliveryplace},
418 basketbillingplace => $basket->{billingplace},
420 for my $place (qw( basketgroupdeliveryplace basketgroupbillingplace basketdeliveryplace basketbillingplace )) {
421 if ( my $library = Koha::Libraries->find( $temp->{$place} ) ) {
422 $row->{$place} = $library->branchname;
426 basketname author title publishercode collectiontitle notes
427 booksellername bookselleraddress booksellerpostal contractname
428 basketgroupdeliveryplace basketgroupbillingplace
429 basketdeliveryplace basketbillingplace
431 # Double the quotes to not be interpreted as a field end
432 $row->{$_} =~ s/"/""/g if $row->{$_};
437 $template->param(rows => \@rows);
439 return $template->output;
443 =head3 CloseBasketgroup
445 &CloseBasketgroup($basketgroupno);
451 sub CloseBasketgroup {
452 my ($basketgroupno) = @_;
453 my $dbh = C4::Context->dbh;
454 my $sth = $dbh->prepare("
455 UPDATE aqbasketgroups
459 $sth->execute($basketgroupno);
462 #------------------------------------------------------------#
464 =head3 ReOpenBaskergroup($basketgroupno)
466 &ReOpenBaskergroup($basketgroupno);
472 sub ReOpenBasketgroup {
473 my ($basketgroupno) = @_;
474 my $dbh = C4::Context->dbh;
475 my $sth = $dbh->prepare("
476 UPDATE aqbasketgroups
480 $sth->execute($basketgroupno);
483 #------------------------------------------------------------#
488 &DelBasket($basketno);
490 Deletes the basket that has basketno field $basketno in the aqbasket table.
494 =item C<$basketno> is the primary key of the basket in the aqbasket table.
501 my ( $basketno ) = @_;
502 my $query = "DELETE FROM aqbasket WHERE basketno=?";
503 my $dbh = C4::Context->dbh;
504 my $sth = $dbh->prepare($query);
505 $sth->execute($basketno);
509 #------------------------------------------------------------#
513 &ModBasket($basketinfo);
515 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
519 =item C<$basketno> is the primary key of the basket in the aqbasket table.
526 my $basketinfo = shift;
527 my $query = "UPDATE aqbasket SET ";
529 foreach my $key (keys %$basketinfo){
530 if ($key ne 'basketno'){
531 $query .= "$key=?, ";
532 push(@params, $basketinfo->{$key} || undef );
535 # get rid of the "," at the end of $query
536 if (substr($query, length($query)-2) eq ', '){
541 $query .= "WHERE basketno=?";
542 push(@params, $basketinfo->{'basketno'});
543 my $dbh = C4::Context->dbh;
544 my $sth = $dbh->prepare($query);
545 $sth->execute(@params);
550 #------------------------------------------------------------#
552 =head3 ModBasketHeader
554 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
556 Modifies a basket's header.
560 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
562 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
564 =item C<$note> is the "note" field in the "aqbasket" table;
566 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
568 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
570 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
572 =item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
574 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
576 =item C<$is_standing> is the "is_standing" field in the aqbasket table.
578 =item C<$create_items> should be set to 'ordering', 'receiving' or 'cataloguing' (or undef, in which
579 case the AcqCreateItem syspref takes precedence).
585 sub ModBasketHeader {
586 my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items) = @_;
591 SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=?, is_standing=?, create_items=?
595 my $dbh = C4::Context->dbh;
596 my $sth = $dbh->prepare($query);
597 $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items || undef, $basketno);
599 if ( $contractnumber ) {
600 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
601 my $sth2 = $dbh->prepare($query2);
602 $sth2->execute($contractnumber,$basketno);
607 #------------------------------------------------------------#
609 =head3 GetBasketsByBookseller
611 @results = &GetBasketsByBookseller($booksellerid, $extra);
613 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
617 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
619 =item C<$extra> is the extra sql parameters, can be
621 $extra->{groupby}: group baskets by column
622 ex. $extra->{groupby} = aqbasket.basketgroupid
623 $extra->{orderby}: order baskets by column
624 $extra->{limit}: limit number of results (can be helpful for pagination)
630 sub GetBasketsByBookseller {
631 my ($booksellerid, $extra) = @_;
632 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
634 if ($extra->{groupby}) {
635 $query .= " GROUP by $extra->{groupby}";
637 if ($extra->{orderby}){
638 $query .= " ORDER by $extra->{orderby}";
640 if ($extra->{limit}){
641 $query .= " LIMIT $extra->{limit}";
644 my $dbh = C4::Context->dbh;
645 my $sth = $dbh->prepare($query);
646 $sth->execute($booksellerid);
647 return $sth->fetchall_arrayref({});
650 =head3 GetBasketsInfosByBookseller
652 my $baskets = GetBasketsInfosByBookseller($supplierid, $allbaskets);
654 The optional second parameter allbaskets is a boolean allowing you to
655 select all baskets from the supplier; by default only active baskets (open or
656 closed but still something to receive) are returned.
658 Returns in a arrayref of hashref all about booksellers baskets, plus:
659 total_biblios: Number of distinct biblios in basket
660 total_items: Number of items in basket
661 expected_items: Number of non-received items in basket
665 sub GetBasketsInfosByBookseller {
666 my ($supplierid, $allbaskets) = @_;
668 return unless $supplierid;
670 my $dbh = C4::Context->dbh;
672 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,
673 SUM(aqorders.quantity) AS total_items,
675 IF ( aqorders.orderstatus = 'cancelled', aqorders.quantity, 0 )
676 ) AS total_items_cancelled,
677 COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
679 IF(aqorders.datereceived IS NULL
680 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
685 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
686 WHERE booksellerid = ?};
688 $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";
690 unless ( $allbaskets ) {
691 # Don't show the basket if it's NOT CLOSED or is FULLY RECEIVED
692 $query.=" HAVING (closedate IS NULL OR (
694 IF(aqorders.datereceived IS NULL
695 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
701 my $sth = $dbh->prepare($query);
702 $sth->execute($supplierid);
703 my $baskets = $sth->fetchall_arrayref({});
705 # Retrieve the number of biblios cancelled
706 my $cancelled_biblios = $dbh->selectall_hashref( q|
707 SELECT COUNT(DISTINCT(biblionumber)) AS total_biblios_cancelled, aqbasket.basketno
709 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
710 WHERE booksellerid = ?
711 AND aqorders.orderstatus = 'cancelled'
712 GROUP BY aqbasket.basketno
713 |, 'basketno', {}, $supplierid );
715 $_->{total_biblios_cancelled} = $cancelled_biblios->{$_->{basketno}}{total_biblios_cancelled} || 0
721 =head3 GetBasketUsers
723 $basketusers_ids = &GetBasketUsers($basketno);
725 Returns a list of all borrowernumbers that are in basket users list
730 my $basketno = shift;
732 return unless $basketno;
735 SELECT borrowernumber
739 my $dbh = C4::Context->dbh;
740 my $sth = $dbh->prepare($query);
741 $sth->execute($basketno);
742 my $results = $sth->fetchall_arrayref( {} );
745 foreach (@$results) {
746 push @borrowernumbers, $_->{'borrowernumber'};
749 return @borrowernumbers;
752 =head3 ModBasketUsers
754 my @basketusers_ids = (1, 2, 3);
755 &ModBasketUsers($basketno, @basketusers_ids);
757 Delete all users from basket users list, and add users in C<@basketusers_ids>
763 my ($basketno, @basketusers_ids) = @_;
765 return unless $basketno;
767 my $dbh = C4::Context->dbh;
769 DELETE FROM aqbasketusers
772 my $sth = $dbh->prepare($query);
773 $sth->execute($basketno);
776 INSERT INTO aqbasketusers (basketno, borrowernumber)
779 $sth = $dbh->prepare($query);
780 foreach my $basketuser_id (@basketusers_ids) {
781 $sth->execute($basketno, $basketuser_id);
786 =head3 CanUserManageBasket
788 my $bool = CanUserManageBasket($borrower, $basket[, $userflags]);
789 my $bool = CanUserManageBasket($borrowernumber, $basketno[, $userflags]);
791 Check if a borrower can manage a basket, according to system preference
792 AcqViewBaskets, user permissions and basket properties (creator, users list,
795 First parameter can be either a borrowernumber or a hashref as returned by
796 Koha::Patron->unblessed
798 Second parameter can be either a basketno or a hashref as returned by
799 C4::Acquisition::GetBasket.
801 The third parameter is optional. If given, it should be a hashref as returned
802 by C4::Auth::getuserflags. If not, getuserflags is called.
804 If user is authorised to manage basket, returns 1.
809 sub CanUserManageBasket {
810 my ($borrower, $basket, $userflags) = @_;
812 if (!ref $borrower) {
813 # FIXME This needs to be replaced
814 # We should not accept both scalar and array
815 # Tests need to be updated
816 $borrower = Koha::Patrons->find( $borrower )->unblessed;
819 $basket = GetBasket($basket);
822 return 0 unless ($basket and $borrower);
824 my $borrowernumber = $borrower->{borrowernumber};
825 my $basketno = $basket->{basketno};
827 my $AcqViewBaskets = C4::Context->preference('AcqViewBaskets');
829 if (!defined $userflags) {
830 my $dbh = C4::Context->dbh;
831 my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE borrowernumber = ?");
832 $sth->execute($borrowernumber);
833 my ($flags) = $sth->fetchrow_array;
836 $userflags = C4::Auth::getuserflags($flags, $borrower->{userid}, $dbh);
839 unless ($userflags->{superlibrarian}
840 || (ref $userflags->{acquisition} && $userflags->{acquisition}->{order_manage_all})
841 || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
843 if (not exists $userflags->{acquisition}) {
847 if ( (ref $userflags->{acquisition} && !$userflags->{acquisition}->{order_manage})
848 || (!ref $userflags->{acquisition} && !$userflags->{acquisition}) ) {
852 if ($AcqViewBaskets eq 'user'
853 && $basket->{authorisedby} != $borrowernumber
854 && ! grep { $borrowernumber eq $_ } GetBasketUsers($basketno)) {
858 if ($AcqViewBaskets eq 'branch' && defined $basket->{branch}
859 && $basket->{branch} ne $borrower->{branchcode}) {
867 #------------------------------------------------------------#
869 =head3 GetBasketsByBasketgroup
871 $baskets = &GetBasketsByBasketgroup($basketgroupid);
873 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
877 sub GetBasketsByBasketgroup {
878 my $basketgroupid = shift;
880 SELECT *, aqbasket.booksellerid as booksellerid
882 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?
884 my $dbh = C4::Context->dbh;
885 my $sth = $dbh->prepare($query);
886 $sth->execute($basketgroupid);
887 return $sth->fetchall_arrayref({});
890 #------------------------------------------------------------#
892 =head3 NewBasketgroup
894 $basketgroupid = NewBasketgroup(\%hashref);
896 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
898 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
900 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
902 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
904 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
906 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
908 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
910 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
912 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
917 my $basketgroupinfo = shift;
918 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
919 my $query = "INSERT INTO aqbasketgroups (";
921 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
922 if ( defined $basketgroupinfo->{$field} ) {
923 $query .= "$field, ";
924 push(@params, $basketgroupinfo->{$field});
927 $query .= "booksellerid) VALUES (";
932 push(@params, $basketgroupinfo->{'booksellerid'});
933 my $dbh = C4::Context->dbh;
934 my $sth = $dbh->prepare($query);
935 $sth->execute(@params);
936 my $basketgroupid = $dbh->{'mysql_insertid'};
937 if( $basketgroupinfo->{'basketlist'} ) {
938 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
939 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
940 my $sth2 = $dbh->prepare($query2);
941 $sth2->execute($basketgroupid, $basketno);
944 return $basketgroupid;
947 #------------------------------------------------------------#
949 =head3 ModBasketgroup
951 ModBasketgroup(\%hashref);
953 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
955 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
957 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
959 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
961 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
963 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
965 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
967 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
969 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
974 my $basketgroupinfo = shift;
975 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
976 my $dbh = C4::Context->dbh;
977 my $query = "UPDATE aqbasketgroups SET ";
979 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
980 if ( defined $basketgroupinfo->{$field} ) {
981 $query .= "$field=?, ";
982 push(@params, $basketgroupinfo->{$field});
987 $query .= " WHERE id=?";
988 push(@params, $basketgroupinfo->{'id'});
989 my $sth = $dbh->prepare($query);
990 $sth->execute(@params);
992 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
993 $sth->execute($basketgroupinfo->{'id'});
995 if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
996 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
997 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
998 $sth->execute($basketgroupinfo->{'id'}, $basketno);
1004 #------------------------------------------------------------#
1006 =head3 DelBasketgroup
1008 DelBasketgroup($basketgroupid);
1010 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
1014 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
1020 sub DelBasketgroup {
1021 my $basketgroupid = shift;
1022 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1023 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
1024 my $dbh = C4::Context->dbh;
1025 my $sth = $dbh->prepare($query);
1026 $sth->execute($basketgroupid);
1030 #------------------------------------------------------------#
1033 =head2 FUNCTIONS ABOUT ORDERS
1035 =head3 GetBasketgroup
1037 $basketgroup = &GetBasketgroup($basketgroupid);
1039 Returns a reference to the hash containing all information about the basketgroup.
1043 sub GetBasketgroup {
1044 my $basketgroupid = shift;
1045 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1046 my $dbh = C4::Context->dbh;
1047 my $result_set = $dbh->selectall_arrayref(
1048 'SELECT * FROM aqbasketgroups WHERE id=?',
1052 return $result_set->[0]; # id is unique
1055 #------------------------------------------------------------#
1057 =head3 GetBasketgroups
1059 $basketgroups = &GetBasketgroups($booksellerid);
1061 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
1065 sub GetBasketgroups {
1066 my $booksellerid = shift;
1067 die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
1068 my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
1069 my $dbh = C4::Context->dbh;
1070 my $sth = $dbh->prepare($query);
1071 $sth->execute($booksellerid);
1072 return $sth->fetchall_arrayref({});
1075 #------------------------------------------------------------#
1077 =head2 FUNCTIONS ABOUT ORDERS
1081 @orders = &GetOrders( $basketno, { orderby => 'biblio.title', cancelled => 0|1 } );
1083 Looks up the pending (non-cancelled) orders with the given basket
1086 If cancelled is set, only cancelled orders will be returned.
1091 my ( $basketno, $params ) = @_;
1093 return () unless $basketno;
1095 my $orderby = $params->{orderby};
1096 my $cancelled = $params->{cancelled} || 0;
1098 my $dbh = C4::Context->dbh;
1100 SELECT biblio.*,biblioitems.*,
1104 $query .= $cancelled
1106 aqorders_transfers.ordernumber_to AS transferred_to,
1107 aqorders_transfers.timestamp AS transferred_to_timestamp
1110 aqorders_transfers.ordernumber_from AS transferred_from,
1111 aqorders_transfers.timestamp AS transferred_from_timestamp
1115 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1116 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1117 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1119 $query .= $cancelled
1121 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
1124 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1132 $orderby ||= q|biblioitems.publishercode, biblio.title|;
1134 AND (datecancellationprinted IS NOT NULL
1135 AND datecancellationprinted <> '0000-00-00')
1140 q|aqorders.datecancellationprinted desc, aqorders.timestamp desc|;
1142 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
1146 $query .= " ORDER BY $orderby";
1148 $dbh->selectall_arrayref( $query, { Slice => {} }, $basketno );
1153 #------------------------------------------------------------#
1155 =head3 GetOrdersByBiblionumber
1157 @orders = &GetOrdersByBiblionumber($biblionumber);
1159 Looks up the orders with linked to a specific $biblionumber, including
1160 cancelled orders and received orders.
1163 C<@orders> is an array of references-to-hash, whose keys are the
1164 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
1168 sub GetOrdersByBiblionumber {
1169 my $biblionumber = shift;
1170 return unless $biblionumber;
1171 my $dbh = C4::Context->dbh;
1173 SELECT biblio.*,biblioitems.*,
1177 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1178 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1179 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1180 WHERE aqorders.biblionumber=?
1183 $dbh->selectall_arrayref( $query, { Slice => {} }, $biblionumber );
1184 return @{$result_set};
1188 #------------------------------------------------------------#
1192 $order = &GetOrder($ordernumber);
1194 Looks up an order by order number.
1196 Returns a reference-to-hash describing the order. The keys of
1197 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1202 my ($ordernumber) = @_;
1203 return unless $ordernumber;
1205 my $dbh = C4::Context->dbh;
1206 my $query = qq{SELECT
1210 aqbasket.basketname,
1211 borrowers.branchcode,
1212 biblioitems.publicationyear,
1213 biblio.copyrightdate,
1214 biblioitems.editionstatement,
1218 biblioitems.publishercode,
1219 aqorders.rrp AS unitpricesupplier,
1220 aqorders.ecost AS unitpricelib,
1221 aqorders.claims_count AS claims_count,
1222 aqorders.claimed_date AS claimed_date,
1223 aqbudgets.budget_name AS budget,
1224 aqbooksellers.name AS supplier,
1225 aqbooksellers.id AS supplierid,
1226 biblioitems.publishercode AS publisher,
1227 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1228 DATE(aqbasket.closedate) AS orderdate,
1229 aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity_to_receive,
1230 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1231 DATEDIFF(CURDATE( ),closedate) AS latesince
1232 FROM aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1233 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1234 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1235 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
1236 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1237 WHERE aqorders.basketno = aqbasket.basketno
1240 $dbh->selectall_arrayref( $query, { Slice => {} }, $ordernumber );
1242 # result_set assumed to contain 1 match
1243 return $result_set->[0];
1246 =head3 GetLastOrderNotReceivedFromSubscriptionid
1248 $order = &GetLastOrderNotReceivedFromSubscriptionid($subscriptionid);
1250 Returns a reference-to-hash describing the last order not received for a subscription.
1254 sub GetLastOrderNotReceivedFromSubscriptionid {
1255 my ( $subscriptionid ) = @_;
1256 my $dbh = C4::Context->dbh;
1258 SELECT * FROM aqorders
1259 LEFT JOIN subscription
1260 ON ( aqorders.subscriptionid = subscription.subscriptionid )
1261 WHERE aqorders.subscriptionid = ?
1262 AND aqorders.datereceived IS NULL
1266 $dbh->selectall_arrayref( $query, { Slice => {} }, $subscriptionid );
1268 # result_set assumed to contain 1 match
1269 return $result_set->[0];
1272 =head3 GetLastOrderReceivedFromSubscriptionid
1274 $order = &GetLastOrderReceivedFromSubscriptionid($subscriptionid);
1276 Returns a reference-to-hash describing the last order received for a subscription.
1280 sub GetLastOrderReceivedFromSubscriptionid {
1281 my ( $subscriptionid ) = @_;
1282 my $dbh = C4::Context->dbh;
1284 SELECT * FROM aqorders
1285 LEFT JOIN subscription
1286 ON ( aqorders.subscriptionid = subscription.subscriptionid )
1287 WHERE aqorders.subscriptionid = ?
1288 AND aqorders.datereceived =
1290 SELECT MAX( aqorders.datereceived )
1292 LEFT JOIN subscription
1293 ON ( aqorders.subscriptionid = subscription.subscriptionid )
1294 WHERE aqorders.subscriptionid = ?
1295 AND aqorders.datereceived IS NOT NULL
1297 ORDER BY ordernumber DESC
1301 $dbh->selectall_arrayref( $query, { Slice => {} }, $subscriptionid, $subscriptionid );
1303 # result_set assumed to contain 1 match
1304 return $result_set->[0];
1308 #------------------------------------------------------------#
1312 &ModOrder(\%hashref);
1314 Modifies an existing order. Updates the order with order number
1315 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1316 other keys of the hash update the fields with the same name in the aqorders
1317 table of the Koha database.
1322 my $orderinfo = shift;
1324 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '';
1326 my $dbh = C4::Context->dbh;
1329 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1330 $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1332 # delete($orderinfo->{'branchcode'});
1333 # the hash contains a lot of entries not in aqorders, so get the columns ...
1334 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1336 my $colnames = $sth->{NAME};
1337 #FIXME Be careful. If aqorders would have columns with diacritics,
1338 #you should need to decode what you get back from NAME.
1339 #See report 10110 and guided_reports.pl
1340 my $query = "UPDATE aqorders SET ";
1342 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1343 # ... and skip hash entries that are not in the aqorders table
1344 # FIXME : probably not the best way to do it (would be better to have a correct hash)
1345 next unless grep(/^$orderinfokey$/, @$colnames);
1346 $query .= "$orderinfokey=?, ";
1347 push(@params, $orderinfo->{$orderinfokey});
1350 $query .= "timestamp=NOW() WHERE ordernumber=?";
1351 push(@params, $orderinfo->{'ordernumber'} );
1352 $sth = $dbh->prepare($query);
1353 $sth->execute(@params);
1357 #------------------------------------------------------------#
1361 ModItemOrder($itemnumber, $ordernumber);
1363 Modifies the ordernumber of an item in aqorders_items.
1368 my ($itemnumber, $ordernumber) = @_;
1370 return unless ($itemnumber and $ordernumber);
1372 my $dbh = C4::Context->dbh;
1374 UPDATE aqorders_items
1376 WHERE itemnumber = ?
1378 my $sth = $dbh->prepare($query);
1379 return $sth->execute($ordernumber, $itemnumber);
1382 #------------------------------------------------------------#
1384 =head3 ModReceiveOrder
1386 my ( $date_received, $new_ordernumber ) = ModReceiveOrder(
1388 biblionumber => $biblionumber,
1390 quantityreceived => $quantityreceived,
1392 invoice => $invoice,
1393 budget_id => $budget_id,
1394 received_itemnumbers => \@received_itemnumbers,
1395 order_internalnote => $order_internalnote,
1399 Updates an order, to reflect the fact that it was received, at least
1402 If a partial order is received, splits the order into two.
1404 Updates the order with biblionumber C<$biblionumber> and ordernumber
1405 C<$order->{ordernumber}>.
1410 sub ModReceiveOrder {
1412 my $biblionumber = $params->{biblionumber};
1413 my $order = { %{ $params->{order} } }; # Copy the order, we don't want to modify it
1414 my $invoice = $params->{invoice};
1415 my $quantrec = $params->{quantityreceived};
1416 my $user = $params->{user};
1417 my $budget_id = $params->{budget_id};
1418 my $received_items = $params->{received_items};
1420 my $dbh = C4::Context->dbh;
1421 my $datereceived = ( $invoice and $invoice->{datereceived} ) ? $invoice->{datereceived} : dt_from_string;
1422 my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1423 if ($suggestionid) {
1424 ModSuggestion( {suggestionid=>$suggestionid,
1425 STATUS=>'AVAILABLE',
1426 biblionumber=> $biblionumber}
1430 my $result_set = $dbh->selectrow_arrayref(
1431 q{SELECT aqbasket.is_standing
1433 WHERE basketno=?},{ Slice => {} }, $order->{basketno});
1434 my $is_standing = $result_set->[0]; # we assume we have a unique basket
1436 my $new_ordernumber = $order->{ordernumber};
1437 if ( $is_standing || $order->{quantity} > $quantrec ) {
1438 # Split order line in two parts: the first is the original order line
1439 # without received items (the quantity is decreased),
1440 # the second part is a new order line with quantity=quantityrec
1441 # (entirely received)
1445 orderstatus = 'partial'|;
1446 $query .= q| WHERE ordernumber = ?|;
1447 my $sth = $dbh->prepare($query);
1450 ( $is_standing ? 1 : ($order->{quantity} - $quantrec) ),
1451 $order->{ordernumber}
1454 if ( not $order->{subscriptionid} && defined $order->{order_internalnote} ) {
1455 $dbh->do(q|UPDATE aqorders
1456 SET order_internalnote = ?|, {}, $order->{order_internalnote});
1459 # Recalculate tax_value
1463 tax_value_on_ordering = quantity * ecost_tax_excluded * tax_rate_on_ordering,
1464 tax_value_on_receiving = quantity * unitprice_tax_excluded * tax_rate_on_receiving
1465 WHERE ordernumber = ?
1466 |, undef, $order->{ordernumber});
1468 delete $order->{ordernumber};
1469 $order->{budget_id} = ( $budget_id || $order->{budget_id} );
1470 $order->{quantity} = $quantrec;
1471 $order->{quantityreceived} = $quantrec;
1472 $order->{ecost_tax_excluded} //= 0;
1473 $order->{tax_rate_on_ordering} //= 0;
1474 $order->{unitprice_tax_excluded} //= 0;
1475 $order->{tax_rate_on_receiving} //= 0;
1476 $order->{tax_value_on_ordering} = $order->{quantity} * $order->{ecost_tax_excluded} * $order->{tax_rate_on_ordering};
1477 $order->{tax_value_on_receiving} = $order->{quantity} * $order->{unitprice_tax_excluded} * $order->{tax_rate_on_receiving};
1478 $order->{datereceived} = $datereceived;
1479 $order->{invoiceid} = $invoice->{invoiceid};
1480 $order->{orderstatus} = 'complete';
1481 $new_ordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber; # TODO What if the store fails?
1483 if ($received_items) {
1484 foreach my $itemnumber (@$received_items) {
1485 ModItemOrder($itemnumber, $new_ordernumber);
1491 SET quantityreceived = ?,
1495 orderstatus = 'complete'
1499 , replacementprice = ?
1500 | if defined $order->{replacementprice};
1503 , unitprice = ?, unitprice_tax_included = ?, unitprice_tax_excluded = ?
1504 | if defined $order->{unitprice};
1507 ,tax_value_on_receiving = ?
1508 | if defined $order->{tax_value_on_receiving};
1511 ,tax_rate_on_receiving = ?
1512 | if defined $order->{tax_rate_on_receiving};
1515 , order_internalnote = ?
1516 | if defined $order->{order_internalnote};
1518 $query .= q| where biblionumber=? and ordernumber=?|;
1520 my $sth = $dbh->prepare( $query );
1521 my @params = ( $quantrec, $datereceived, $invoice->{invoiceid}, ( $budget_id ? $budget_id : $order->{budget_id} ) );
1523 if ( defined $order->{replacementprice} ) {
1524 push @params, $order->{replacementprice};
1527 if ( defined $order->{unitprice} ) {
1528 push @params, $order->{unitprice}, $order->{unitprice_tax_included}, $order->{unitprice_tax_excluded};
1531 if ( defined $order->{tax_value_on_receiving} ) {
1532 push @params, $order->{tax_value_on_receiving};
1535 if ( defined $order->{tax_rate_on_receiving} ) {
1536 push @params, $order->{tax_rate_on_receiving};
1539 if ( defined $order->{order_internalnote} ) {
1540 push @params, $order->{order_internalnote};
1543 push @params, ( $biblionumber, $order->{ordernumber} );
1545 $sth->execute( @params );
1547 # All items have been received, sent a notification to users
1548 NotifyOrderUsers( $order->{ordernumber} );
1551 return ($datereceived, $new_ordernumber);
1554 =head3 CancelReceipt
1556 my $parent_ordernumber = CancelReceipt($ordernumber);
1558 Cancel an order line receipt and update the parent order line, as if no
1560 If items are created at receipt (AcqCreateItem = receiving) then delete
1566 my $ordernumber = shift;
1568 return unless $ordernumber;
1570 my $dbh = C4::Context->dbh;
1572 SELECT datereceived, parent_ordernumber, quantity
1574 WHERE ordernumber = ?
1576 my $sth = $dbh->prepare($query);
1577 $sth->execute($ordernumber);
1578 my $order = $sth->fetchrow_hashref;
1580 warn "CancelReceipt: order $ordernumber does not exist";
1583 unless($order->{'datereceived'}) {
1584 warn "CancelReceipt: order $ordernumber is not received";
1588 my $parent_ordernumber = $order->{'parent_ordernumber'};
1590 my $order_obj = Koha::Acquisition::Orders->find( $ordernumber ); # FIXME rewrite all this subroutine using this object
1591 my @itemnumbers = $order_obj->items->get_column('itemnumber');
1593 if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1594 # The order line has no parent, just mark it as not received
1597 SET quantityreceived = ?,
1600 orderstatus = 'ordered'
1601 WHERE ordernumber = ?
1603 $sth = $dbh->prepare($query);
1604 $sth->execute(0, undef, undef, $ordernumber);
1605 _cancel_items_receipt( $order_obj );
1607 # The order line has a parent, increase parent quantity and delete
1610 SELECT quantity, datereceived
1612 WHERE ordernumber = ?
1614 $sth = $dbh->prepare($query);
1615 $sth->execute($parent_ordernumber);
1616 my $parent_order = $sth->fetchrow_hashref;
1617 unless($parent_order) {
1618 warn "Parent order $parent_ordernumber does not exist.";
1621 if($parent_order->{'datereceived'}) {
1622 warn "CancelReceipt: parent order is received.".
1623 " Can't cancel receipt.";
1629 orderstatus = 'ordered'
1630 WHERE ordernumber = ?
1632 $sth = $dbh->prepare($query);
1633 my $rv = $sth->execute(
1634 $order->{'quantity'} + $parent_order->{'quantity'},
1638 warn "Cannot update parent order line, so do not cancel".
1643 # Recalculate tax_value
1647 tax_value_on_ordering = quantity * ecost_tax_excluded * tax_rate_on_ordering,
1648 tax_value_on_receiving = quantity * unitprice_tax_excluded * tax_rate_on_receiving
1649 WHERE ordernumber = ?
1650 |, undef, $parent_ordernumber);
1652 _cancel_items_receipt( $order_obj, $parent_ordernumber );
1655 DELETE FROM aqorders
1656 WHERE ordernumber = ?
1658 $sth = $dbh->prepare($query);
1659 $sth->execute($ordernumber);
1663 if( $order_obj->basket->effective_create_items eq 'ordering' ) {
1664 my @affects = split q{\|}, C4::Context->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1666 for my $in ( @itemnumbers ) {
1667 my $item = Koha::Items->find( $in ); # FIXME We do not need that, we already have Koha::Items from $order_obj->items
1668 my $biblio = $item->biblio;
1669 my ( $itemfield ) = GetMarcFromKohaField( 'items.itemnumber', $biblio->frameworkcode );
1670 my $item_marc = C4::Items::GetMarcItem( $biblio->biblionumber, $in );
1671 for my $affect ( @affects ) {
1672 my ( $sf, $v ) = split q{=}, $affect, 2;
1673 foreach ( $item_marc->field($itemfield) ) {
1674 $_->update( $sf => $v );
1677 C4::Items::ModItemFromMarc( $item_marc, $biblio->biblionumber, $in );
1682 return $parent_ordernumber;
1685 sub _cancel_items_receipt {
1686 my ( $order, $parent_ordernumber ) = @_;
1687 $parent_ordernumber ||= $order->ordernumber;
1689 my $items = $order->items;
1690 if ( $order->basket->effective_create_items eq 'receiving' ) {
1691 # Remove items that were created at receipt
1693 DELETE FROM items, aqorders_items
1694 USING items, aqorders_items
1695 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1697 my $dbh = C4::Context->dbh;
1698 my $sth = $dbh->prepare($query);
1699 while ( my $item = $items->next ) {
1700 $sth->execute($item->itemnumber, $item->itemnumber);
1704 while ( my $item = $items->next ) {
1705 ModItemOrder($item->itemnumber, $parent_ordernumber);
1710 #------------------------------------------------------------#
1714 @results = &SearchOrders({
1715 ordernumber => $ordernumber,
1718 booksellerid => $booksellerid,
1719 basketno => $basketno,
1720 basketname => $basketname,
1721 basketgroupname => $basketgroupname,
1725 biblionumber => $biblionumber,
1726 budget_id => $budget_id
1729 Searches for orders filtered by criteria.
1731 C<$ordernumber> Finds matching orders or transferred orders by ordernumber.
1732 C<$search> Finds orders matching %$search% in title, author, or isbn.
1733 C<$owner> Finds order for the logged in user.
1734 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1735 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1738 C<@results> is an array of references-to-hash with the keys are fields
1739 from aqorders, biblio, biblioitems and aqbasket tables.
1744 my ( $params ) = @_;
1745 my $ordernumber = $params->{ordernumber};
1746 my $search = $params->{search};
1747 my $ean = $params->{ean};
1748 my $booksellerid = $params->{booksellerid};
1749 my $basketno = $params->{basketno};
1750 my $basketname = $params->{basketname};
1751 my $basketgroupname = $params->{basketgroupname};
1752 my $owner = $params->{owner};
1753 my $pending = $params->{pending};
1754 my $ordered = $params->{ordered};
1755 my $biblionumber = $params->{biblionumber};
1756 my $budget_id = $params->{budget_id};
1758 my $dbh = C4::Context->dbh;
1761 SELECT aqbasket.basketno,
1763 borrowers.firstname,
1766 biblioitems.biblioitemnumber,
1767 biblioitems.publishercode,
1768 biblioitems.publicationyear,
1769 aqbasket.authorisedby,
1770 aqbasket.booksellerid,
1772 aqbasket.creationdate,
1773 aqbasket.basketname,
1774 aqbasketgroups.id as basketgroupid,
1775 aqbasketgroups.name as basketgroupname,
1778 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1779 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1780 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1781 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1782 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1785 # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
1787 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1791 WHERE (datecancellationprinted is NULL)
1794 if ( $pending or $ordered ) {
1797 ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) )
1799 ( quantity > quantityreceived OR quantityreceived is NULL )
1803 $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1811 my $userenv = C4::Context->userenv;
1812 if ( C4::Context->preference("IndependentBranches") ) {
1813 unless ( C4::Context->IsSuperLibrarian() ) {
1816 borrowers.branchcode = ?
1817 OR borrowers.branchcode = ''
1820 push @args, $userenv->{branch};
1824 if ( $ordernumber ) {
1825 $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1826 push @args, ( $ordernumber, $ordernumber );
1828 if ( $biblionumber ) {
1829 $query .= 'AND aqorders.biblionumber = ?';
1830 push @args, $biblionumber;
1833 $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1834 push @args, ("%$search%","%$search%","%$search%");
1837 $query .= ' AND biblioitems.ean = ?';
1840 if ( $booksellerid ) {
1841 $query .= 'AND aqbasket.booksellerid = ?';
1842 push @args, $booksellerid;
1845 $query .= 'AND aqbasket.basketno = ?';
1846 push @args, $basketno;
1849 $query .= 'AND aqbasket.basketname LIKE ?';
1850 push @args, "%$basketname%";
1852 if( $basketgroupname ) {
1853 $query .= ' AND aqbasketgroups.name LIKE ?';
1854 push @args, "%$basketgroupname%";
1858 $query .= ' AND aqbasket.authorisedby=? ';
1859 push @args, $userenv->{'number'};
1863 $query .= ' AND aqorders.budget_id = ?';
1864 push @args, $budget_id;
1867 $query .= ' ORDER BY aqbasket.basketno';
1869 my $sth = $dbh->prepare($query);
1870 $sth->execute(@args);
1871 return $sth->fetchall_arrayref({});
1874 #------------------------------------------------------------#
1878 &DelOrder($biblionumber, $ordernumber);
1880 Cancel the order with the given order and biblio numbers. It does not
1881 delete any entries in the aqorders table, it merely marks them as
1887 my ( $bibnum, $ordernumber, $delete_biblio, $reason ) = @_;
1890 my $dbh = C4::Context->dbh;
1893 SET datecancellationprinted=now(), orderstatus='cancelled'
1896 $query .= ", cancellationreason = ? ";
1899 WHERE biblionumber=? AND ordernumber=?
1901 my $sth = $dbh->prepare($query);
1903 $sth->execute($reason, $bibnum, $ordernumber);
1905 $sth->execute( $bibnum, $ordernumber );
1909 my $order = Koha::Acquisition::Orders->find($ordernumber);
1910 my $items = $order->items;
1911 while ( my $item = $items->next ) { # Should be moved to Koha::Acquisition::Order->delete
1912 my $delcheck = C4::Items::DelItemCheck( $bibnum, $item->itemnumber );
1914 if($delcheck != 1) {
1915 $error->{'delitem'} = 1;
1919 if($delete_biblio) {
1920 # We get the number of remaining items
1921 my $biblio = Koha::Biblios->find( $bibnum );
1922 my $itemcount = $biblio->items->count;
1924 # If there are no items left,
1925 if ( $itemcount == 0 ) {
1926 # We delete the record
1927 my $delcheck = DelBiblio($bibnum);
1930 $error->{'delbiblio'} = 1;
1938 =head3 TransferOrder
1940 my $newordernumber = TransferOrder($ordernumber, $basketno);
1942 Transfer an order line to a basket.
1943 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1944 to BOOKSELLER on DATE' and create new order with internal note
1945 'Transferred from BOOKSELLER on DATE'.
1946 Move all attached items to the new order.
1947 Received orders cannot be transferred.
1948 Return the ordernumber of created order.
1953 my ($ordernumber, $basketno) = @_;
1955 return unless ($ordernumber and $basketno);
1957 my $order = Koha::Acquisition::Orders->find( $ordernumber ) or return;
1958 return if $order->datereceived;
1960 $order = $order->unblessed;
1962 my $basket = GetBasket($basketno);
1963 return unless $basket;
1965 my $dbh = C4::Context->dbh;
1966 my ($query, $sth, $rv);
1970 SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1971 WHERE ordernumber = ?
1973 $sth = $dbh->prepare($query);
1974 $rv = $sth->execute('cancelled', $ordernumber);
1976 delete $order->{'ordernumber'};
1977 delete $order->{parent_ordernumber};
1978 $order->{'basketno'} = $basketno;
1980 my $newordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber;
1983 UPDATE aqorders_items
1985 WHERE ordernumber = ?
1987 $sth = $dbh->prepare($query);
1988 $sth->execute($newordernumber, $ordernumber);
1991 INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1994 $sth = $dbh->prepare($query);
1995 $sth->execute($ordernumber, $newordernumber);
1997 return $newordernumber;
2000 =head2 FUNCTIONS ABOUT PARCELS
2004 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
2006 get a lists of parcels.
2013 is the bookseller this function has to get parcels.
2016 To know on what criteria the results list has to be ordered.
2019 is the booksellerinvoicenumber.
2021 =item $datefrom & $dateto
2022 to know on what date this function has to filter its search.
2027 a pointer on a hash list containing parcel informations as such :
2033 =item Last operation
2035 =item Number of biblio
2037 =item Number of items
2044 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
2045 my $dbh = C4::Context->dbh;
2046 my @query_params = ();
2048 SELECT aqinvoices.invoicenumber,
2049 datereceived,purchaseordernumber,
2050 count(DISTINCT biblionumber) AS biblio,
2051 sum(quantity) AS itemsexpected,
2052 sum(quantityreceived) AS itemsreceived
2053 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
2054 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2055 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
2057 push @query_params, $bookseller;
2059 if ( defined $code ) {
2060 $strsth .= ' and aqinvoices.invoicenumber like ? ';
2061 # add a % to the end of the code to allow stemming.
2062 push @query_params, "$code%";
2065 if ( defined $datefrom ) {
2066 $strsth .= ' and datereceived >= ? ';
2067 push @query_params, $datefrom;
2070 if ( defined $dateto ) {
2071 $strsth .= 'and datereceived <= ? ';
2072 push @query_params, $dateto;
2075 $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
2077 # can't use a placeholder to place this column name.
2078 # but, we could probably be checking to make sure it is a column that will be fetched.
2079 $strsth .= "order by $order " if ($order);
2081 my $sth = $dbh->prepare($strsth);
2083 $sth->execute( @query_params );
2084 my $results = $sth->fetchall_arrayref({});
2088 #------------------------------------------------------------#
2090 =head3 GetLateOrders
2092 @results = &GetLateOrders;
2094 Searches for bookseller with late orders.
2097 the table of supplier with late issues. This table is full of hashref.
2103 my $supplierid = shift;
2105 my $estimateddeliverydatefrom = shift;
2106 my $estimateddeliverydateto = shift;
2108 my $dbh = C4::Context->dbh;
2110 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
2111 my $dbdriver = C4::Context->config("db_scheme") || "mysql";
2113 my @query_params = ();
2115 SELECT aqbasket.basketno,
2116 aqorders.ordernumber,
2117 DATE(aqbasket.closedate) AS orderdate,
2118 aqbasket.basketname AS basketname,
2119 aqbasket.basketgroupid AS basketgroupid,
2120 aqbasketgroups.name AS basketgroupname,
2121 aqorders.rrp AS unitpricesupplier,
2122 aqorders.ecost AS unitpricelib,
2123 aqorders.claims_count AS claims_count,
2124 aqorders.claimed_date AS claimed_date,
2125 aqbudgets.budget_name AS budget,
2126 borrowers.branchcode AS branch,
2127 aqbooksellers.name AS supplier,
2128 aqbooksellers.id AS supplierid,
2129 biblio.author, biblio.title,
2130 biblioitems.publishercode AS publisher,
2131 biblioitems.publicationyear,
2132 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
2136 aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
2137 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
2138 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
2139 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
2140 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
2141 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2142 WHERE aqorders.basketno = aqbasket.basketno
2143 AND ( datereceived = ''
2144 OR datereceived IS NULL
2145 OR aqorders.quantityreceived < aqorders.quantity
2147 AND aqbasket.closedate IS NOT NULL
2148 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
2150 if ($dbdriver eq "mysql") {
2152 aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity,
2153 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
2154 DATEDIFF(CAST(now() AS date),closedate) AS latesince
2156 if ( defined $delay ) {
2157 $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
2158 push @query_params, $delay;
2160 $from .= " AND aqorders.quantity - COALESCE(aqorders.quantityreceived,0) <> 0";
2162 # FIXME: account for IFNULL as above
2164 aqorders.quantity AS quantity,
2165 aqorders.quantity * aqorders.rrp AS subtotal,
2166 (CAST(now() AS date) - closedate) AS latesince
2168 if ( defined $delay ) {
2169 $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
2170 push @query_params, $delay;
2172 $from .= " AND aqorders.quantity <> 0";
2174 if (defined $supplierid) {
2175 $from .= ' AND aqbasket.booksellerid = ? ';
2176 push @query_params, $supplierid;
2178 if (defined $branch) {
2179 $from .= ' AND borrowers.branchcode LIKE ? ';
2180 push @query_params, $branch;
2183 if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
2184 $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
2186 if ( defined $estimateddeliverydatefrom ) {
2187 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
2188 push @query_params, $estimateddeliverydatefrom;
2190 if ( defined $estimateddeliverydateto ) {
2191 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
2192 push @query_params, $estimateddeliverydateto;
2194 if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
2195 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
2197 if (C4::Context->preference("IndependentBranches")
2198 && !C4::Context->IsSuperLibrarian() ) {
2199 $from .= ' AND borrowers.branchcode LIKE ? ';
2200 push @query_params, C4::Context->userenv->{branch};
2202 $from .= " AND orderstatus <> 'cancelled' ";
2203 my $query = "$select $from \nORDER BY latesince, basketno, borrowers.branchcode, supplier";
2204 $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
2205 my $sth = $dbh->prepare($query);
2206 $sth->execute(@query_params);
2208 while (my $data = $sth->fetchrow_hashref) {
2209 push @results, $data;
2214 #------------------------------------------------------------#
2218 \@order_loop = GetHistory( %params );
2220 Retreives some acquisition history information
2230 basket - search both basket name and number
2231 booksellerinvoicenumber
2234 orderstatus (note that orderstatus '' will retrieve orders
2235 of any status except cancelled)
2237 get_canceled_order (if set to a true value, cancelled orders will
2241 $order_loop is a list of hashrefs that each look like this:
2243 'author' => 'Twain, Mark',
2245 'biblionumber' => '215',
2247 'creationdate' => 'MM/DD/YYYY',
2248 'datereceived' => undef,
2251 'invoicenumber' => undef,
2253 'ordernumber' => '1',
2255 'quantityreceived' => undef,
2256 'title' => 'The Adventures of Huckleberry Finn'
2262 # don't run the query if there are no parameters (list would be too long for sure !)
2263 croak "No search params" unless @_;
2265 my $title = $params{title};
2266 my $author = $params{author};
2267 my $isbn = $params{isbn};
2268 my $ean = $params{ean};
2269 my $name = $params{name};
2270 my $from_placed_on = $params{from_placed_on};
2271 my $to_placed_on = $params{to_placed_on};
2272 my $basket = $params{basket};
2273 my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2274 my $basketgroupname = $params{basketgroupname};
2275 my $budget = $params{budget};
2276 my $orderstatus = $params{orderstatus};
2277 my $biblionumber = $params{biblionumber};
2278 my $get_canceled_order = $params{get_canceled_order} || 0;
2279 my $ordernumber = $params{ordernumber};
2280 my $search_children_too = $params{search_children_too} || 0;
2281 my $created_by = $params{created_by} || [];
2282 my $ordernumbers = $params{ordernumbers} || [];
2283 my $additional_fields = $params{additional_fields} // [];
2287 my $total_qtyreceived = 0;
2288 my $total_price = 0;
2290 #get variation of isbn
2294 if ( C4::Context->preference("SearchWithISBNVariations") ){
2295 @isbns = C4::Koha::GetVariationsOfISBN( $isbn );
2296 foreach my $isb (@isbns){
2297 push @isbn_params, '?';
2302 push @isbn_params, '?';
2306 my $dbh = C4::Context->dbh;
2309 COALESCE(biblio.title, deletedbiblio.title) AS title,
2310 COALESCE(biblio.author, deletedbiblio.author) AS author,
2311 COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2312 COALESCE(biblioitems.ean, deletedbiblioitems.ean) AS ean,
2314 aqbasket.basketname,
2315 aqbasket.basketgroupid,
2316 aqbasket.authorisedby,
2317 concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2318 aqbasketgroups.name as groupname,
2320 aqbasket.creationdate,
2321 aqorders.datereceived,
2323 aqorders.quantityreceived,
2325 aqorders.ordernumber,
2327 aqinvoices.invoicenumber,
2328 aqbooksellers.id as id,
2329 aqorders.biblionumber,
2330 aqorders.orderstatus,
2331 aqorders.parent_ordernumber,
2332 aqbudgets.budget_name
2334 $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2337 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2338 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2339 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2340 LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2341 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2342 LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2343 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2344 LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2345 LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2346 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2349 $query .= " WHERE 1 ";
2351 unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2352 $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2355 my @query_params = ();
2357 if ( $biblionumber ) {
2358 $query .= " AND biblio.biblionumber = ?";
2359 push @query_params, $biblionumber;
2363 $query .= " AND biblio.title LIKE ? ";
2364 $title =~ s/\s+/%/g;
2365 push @query_params, "%$title%";
2369 $query .= " AND biblio.author LIKE ? ";
2370 push @query_params, "%$author%";
2374 $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2375 foreach my $isb (@isbns){
2376 push @query_params, "%$isb%";
2381 $query .= " AND biblioitems.ean = ? ";
2382 push @query_params, "$ean";
2385 $query .= " AND aqbooksellers.name LIKE ? ";
2386 push @query_params, "%$name%";
2390 $query .= " AND aqbudgets.budget_id = ? ";
2391 push @query_params, "$budget";
2394 if ( $from_placed_on ) {
2395 $query .= " AND creationdate >= ? ";
2396 push @query_params, $from_placed_on;
2399 if ( $to_placed_on ) {
2400 $query .= " AND creationdate <= ? ";
2401 push @query_params, $to_placed_on;
2404 if ( defined $orderstatus and $orderstatus ne '') {
2405 $query .= " AND aqorders.orderstatus = ? ";
2406 push @query_params, "$orderstatus";
2410 if ($basket =~ m/^\d+$/) {
2411 $query .= " AND aqorders.basketno = ? ";
2412 push @query_params, $basket;
2414 $query .= " AND aqbasket.basketname LIKE ? ";
2415 push @query_params, "%$basket%";
2419 if ($booksellerinvoicenumber) {
2420 $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2421 push @query_params, "%$booksellerinvoicenumber%";
2424 if ($basketgroupname) {
2425 $query .= " AND aqbasketgroups.name LIKE ? ";
2426 push @query_params, "%$basketgroupname%";
2430 $query .= " AND (aqorders.ordernumber = ? ";
2431 push @query_params, $ordernumber;
2432 if ($search_children_too) {
2433 $query .= " OR aqorders.parent_ordernumber = ? ";
2434 push @query_params, $ordernumber;
2439 if ( @$created_by ) {
2440 $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2441 push @query_params, @$created_by;
2444 if ( @$ordernumbers ) {
2445 $query .= ' AND (aqorders.ordernumber IN ( ' . join (',', ('?') x @$ordernumbers ) . '))';
2446 push @query_params, @$ordernumbers;
2447 if ( @$additional_fields ) {
2448 my $matching_record_ids_for_additional_fields = Koha::AdditionalField->get_matching_record_ids( {
2449 fields => $additional_fields,
2450 tablename => 'aqbasket',
2453 return [] unless @$matching_record_ids_for_additional_fields;
2455 # No parameterization because record IDs come directly from DB
2456 $query .= ' AND aqbasket.basketno IN ( ' . join( ',', @$matching_record_ids_for_additional_fields ) . ' )';
2459 if ( C4::Context->preference("IndependentBranches") ) {
2460 unless ( C4::Context->IsSuperLibrarian() ) {
2461 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2462 push @query_params, C4::Context->userenv->{branch};
2465 $query .= " ORDER BY id";
2467 return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2470 =head2 GetRecentAcqui
2472 $results = GetRecentAcqui($days);
2474 C<$results> is a ref to a table which contains hashref
2478 sub GetRecentAcqui {
2480 my $dbh = C4::Context->dbh;
2484 ORDER BY timestamp DESC
2487 my $sth = $dbh->prepare($query);
2489 my $results = $sth->fetchall_arrayref({});
2493 #------------------------------------------------------------#
2497 &AddClaim($ordernumber);
2499 Add a claim for an order
2504 my ($ordernumber) = @_;
2505 my $dbh = C4::Context->dbh;
2508 claims_count = claims_count + 1,
2509 claimed_date = CURDATE()
2510 WHERE ordernumber = ?
2512 my $sth = $dbh->prepare($query);
2513 $sth->execute($ordernumber);
2518 my @invoices = GetInvoices(
2519 invoicenumber => $invoicenumber,
2520 supplierid => $supplierid,
2521 suppliername => $suppliername,
2522 shipmentdatefrom => $shipmentdatefrom, # ISO format
2523 shipmentdateto => $shipmentdateto, # ISO format
2524 billingdatefrom => $billingdatefrom, # ISO format
2525 billingdateto => $billingdateto, # ISO format
2526 isbneanissn => $isbn_or_ean_or_issn,
2529 publisher => $publisher,
2530 publicationyear => $publicationyear,
2531 branchcode => $branchcode,
2532 order_by => $order_by
2535 Return a list of invoices that match all given criteria.
2537 $order_by is "column_name (asc|desc)", where column_name is any of
2538 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2539 'shipmentcost', 'shipmentcost_budgetid'.
2541 asc is the default if omitted
2548 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2549 closedate shipmentcost shipmentcost_budgetid);
2551 my $dbh = C4::Context->dbh;
2553 SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
2554 aqbooksellers.name AS suppliername,
2557 aqorders.datereceived IS NOT NULL,
2558 aqorders.biblionumber,
2561 ) AS receivedbiblios,
2564 aqorders.subscriptionid IS NOT NULL,
2565 aqorders.subscriptionid,
2568 ) AS is_linked_to_subscriptions,
2569 SUM(aqorders.quantityreceived) AS receiveditems
2571 LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2572 LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2573 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2574 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2575 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2576 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2577 LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2582 if($args{supplierid}) {
2583 push @bind_strs, " aqinvoices.booksellerid = ? ";
2584 push @bind_args, $args{supplierid};
2586 if($args{invoicenumber}) {
2587 push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2588 push @bind_args, "%$args{invoicenumber}%";
2590 if($args{suppliername}) {
2591 push @bind_strs, " aqbooksellers.name LIKE ? ";
2592 push @bind_args, "%$args{suppliername}%";
2594 if($args{shipmentdatefrom}) {
2595 push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2596 push @bind_args, $args{shipmentdatefrom};
2598 if($args{shipmentdateto}) {
2599 push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2600 push @bind_args, $args{shipmentdateto};
2602 if($args{billingdatefrom}) {
2603 push @bind_strs, " aqinvoices.billingdate >= ? ";
2604 push @bind_args, $args{billingdatefrom};
2606 if($args{billingdateto}) {
2607 push @bind_strs, " aqinvoices.billingdate <= ? ";
2608 push @bind_args, $args{billingdateto};
2610 if($args{isbneanissn}) {
2611 push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2612 push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2615 push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2616 push @bind_args, $args{title};
2619 push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2620 push @bind_args, $args{author};
2622 if($args{publisher}) {
2623 push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2624 push @bind_args, $args{publisher};
2626 if($args{publicationyear}) {
2627 push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2628 push @bind_args, $args{publicationyear}, $args{publicationyear};
2630 if($args{branchcode}) {
2631 push @bind_strs, " borrowers.branchcode = ? ";
2632 push @bind_args, $args{branchcode};
2634 if($args{message_id}) {
2635 push @bind_strs, " aqinvoices.message_id = ? ";
2636 push @bind_args, $args{message_id};
2639 $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2640 $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";
2642 if($args{order_by}) {
2643 my ($column, $direction) = split / /, $args{order_by};
2644 if(grep /^$column$/, @columns) {
2645 $direction ||= 'ASC';
2646 $query .= " ORDER BY $column $direction";
2650 my $sth = $dbh->prepare($query);
2651 $sth->execute(@bind_args);
2653 my $results = $sth->fetchall_arrayref({});
2659 my $invoice = GetInvoice($invoiceid);
2661 Get informations about invoice with given $invoiceid
2663 Return a hash filled with aqinvoices.* fields
2668 my ($invoiceid) = @_;
2671 return unless $invoiceid;
2673 my $dbh = C4::Context->dbh;
2679 my $sth = $dbh->prepare($query);
2680 $sth->execute($invoiceid);
2682 $invoice = $sth->fetchrow_hashref;
2686 =head3 GetInvoiceDetails
2688 my $invoice = GetInvoiceDetails($invoiceid)
2690 Return informations about an invoice + the list of related order lines
2692 Orders informations are in $invoice->{orders} (array ref)
2696 sub GetInvoiceDetails {
2697 my ($invoiceid) = @_;
2699 if ( !defined $invoiceid ) {
2700 carp 'GetInvoiceDetails called without an invoiceid';
2704 my $dbh = C4::Context->dbh;
2706 SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2708 LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2711 my $sth = $dbh->prepare($query);
2712 $sth->execute($invoiceid);
2714 my $invoice = $sth->fetchrow_hashref;
2719 biblio.copyrightdate,
2721 biblioitems.publishercode,
2722 biblioitems.publicationyear,
2723 aqbasket.basketname,
2724 aqbasketgroups.id AS basketgroupid,
2725 aqbasketgroups.name AS basketgroupname
2727 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2728 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2729 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2730 LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2733 $sth = $dbh->prepare($query);
2734 $sth->execute($invoiceid);
2735 $invoice->{orders} = $sth->fetchall_arrayref({});
2736 $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2743 my $invoiceid = AddInvoice(
2744 invoicenumber => $invoicenumber,
2745 booksellerid => $booksellerid,
2746 shipmentdate => $shipmentdate,
2747 billingdate => $billingdate,
2748 closedate => $closedate,
2749 shipmentcost => $shipmentcost,
2750 shipmentcost_budgetid => $shipmentcost_budgetid
2753 Create a new invoice and return its id or undef if it fails.
2760 return unless(%invoice and $invoice{invoicenumber});
2762 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2763 closedate shipmentcost shipmentcost_budgetid message_id);
2767 foreach my $key (keys %invoice) {
2768 if(0 < grep(/^$key$/, @columns)) {
2769 push @set_strs, "$key = ?";
2770 push @set_args, ($invoice{$key} || undef);
2776 my $dbh = C4::Context->dbh;
2777 my $query = "INSERT INTO aqinvoices SET ";
2778 $query .= join (",", @set_strs);
2779 my $sth = $dbh->prepare($query);
2780 $rv = $sth->execute(@set_args);
2782 $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2791 invoiceid => $invoiceid, # Mandatory
2792 invoicenumber => $invoicenumber,
2793 booksellerid => $booksellerid,
2794 shipmentdate => $shipmentdate,
2795 billingdate => $billingdate,
2796 closedate => $closedate,
2797 shipmentcost => $shipmentcost,
2798 shipmentcost_budgetid => $shipmentcost_budgetid
2801 Modify an invoice, invoiceid is mandatory.
2803 Return undef if it fails.
2810 return unless(%invoice and $invoice{invoiceid});
2812 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2813 closedate shipmentcost shipmentcost_budgetid);
2817 foreach my $key (keys %invoice) {
2818 if(0 < grep(/^$key$/, @columns)) {
2819 push @set_strs, "$key = ?";
2820 push @set_args, ($invoice{$key} || undef);
2824 my $dbh = C4::Context->dbh;
2825 my $query = "UPDATE aqinvoices SET ";
2826 $query .= join(",", @set_strs);
2827 $query .= " WHERE invoiceid = ?";
2829 my $sth = $dbh->prepare($query);
2830 $sth->execute(@set_args, $invoice{invoiceid});
2835 CloseInvoice($invoiceid);
2839 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2844 my ($invoiceid) = @_;
2846 return unless $invoiceid;
2848 my $dbh = C4::Context->dbh;
2851 SET closedate = CAST(NOW() AS DATE)
2854 my $sth = $dbh->prepare($query);
2855 $sth->execute($invoiceid);
2858 =head3 ReopenInvoice
2860 ReopenInvoice($invoiceid);
2864 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2869 my ($invoiceid) = @_;
2871 return unless $invoiceid;
2873 my $dbh = C4::Context->dbh;
2876 SET closedate = NULL
2879 my $sth = $dbh->prepare($query);
2880 $sth->execute($invoiceid);
2885 DelInvoice($invoiceid);
2887 Delete an invoice if there are no items attached to it.
2892 my ($invoiceid) = @_;
2894 return unless $invoiceid;
2896 my $dbh = C4::Context->dbh;
2902 my $sth = $dbh->prepare($query);
2903 $sth->execute($invoiceid);
2904 my $res = $sth->fetchrow_arrayref;
2905 if ( $res && $res->[0] == 0 ) {
2907 DELETE FROM aqinvoices
2910 my $sth = $dbh->prepare($query);
2911 return ( $sth->execute($invoiceid) > 0 );
2916 =head3 MergeInvoices
2918 MergeInvoices($invoiceid, \@sourceids);
2920 Merge the invoices identified by the IDs in \@sourceids into
2921 the invoice identified by $invoiceid.
2926 my ($invoiceid, $sourceids) = @_;
2928 return unless $invoiceid;
2929 foreach my $sourceid (@$sourceids) {
2930 next if $sourceid == $invoiceid;
2931 my $source = GetInvoiceDetails($sourceid);
2932 foreach my $order (@{$source->{'orders'}}) {
2933 $order->{'invoiceid'} = $invoiceid;
2936 DelInvoice($source->{'invoiceid'});
2941 =head3 GetBiblioCountByBasketno
2943 $biblio_count = &GetBiblioCountByBasketno($basketno);
2945 Looks up the biblio's count that has basketno value $basketno
2951 sub GetBiblioCountByBasketno {
2952 my ($basketno) = @_;
2953 my $dbh = C4::Context->dbh;
2955 SELECT COUNT( DISTINCT( biblionumber ) )
2958 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
2961 my $sth = $dbh->prepare($query);
2962 $sth->execute($basketno);
2963 return $sth->fetchrow;
2966 # Note this subroutine should be moved to Koha::Acquisition::Order
2967 # Will do when a DBIC decision will be taken.
2968 sub populate_order_with_prices {
2971 my $order = $params->{order};
2972 my $booksellerid = $params->{booksellerid};
2973 return unless $booksellerid;
2975 my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
2977 my $receiving = $params->{receiving};
2978 my $ordering = $params->{ordering};
2979 my $discount = $order->{discount};
2980 $discount /= 100 if $discount > 1;
2983 $order->{tax_rate_on_ordering} //= $order->{tax_rate};
2984 if ( $bookseller->listincgst ) {
2985 # The user entered the rrp tax included
2986 $order->{rrp_tax_included} = $order->{rrp};
2988 # rrp tax excluded = rrp tax included / ( 1 + tax rate )
2989 $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2991 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2992 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2994 # ecost tax included = rrp tax included ( 1 - discount )
2995 $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
2998 # The user entered the rrp tax excluded
2999 $order->{rrp_tax_excluded} = $order->{rrp};
3001 # rrp tax included = rrp tax excluded * ( 1 - tax rate )
3002 $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
3004 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
3005 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
3007 # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount )
3008 $order->{ecost_tax_included} =
3009 $order->{rrp_tax_excluded} *
3010 ( 1 + $order->{tax_rate_on_ordering} ) *
3014 # tax value = quantity * ecost tax excluded * tax rate
3015 $order->{tax_value_on_ordering} =
3016 $order->{quantity} * $order->{ecost_tax_excluded} * $order->{tax_rate_on_ordering};
3020 $order->{tax_rate_on_receiving} //= $order->{tax_rate};
3021 if ( $bookseller->invoiceincgst ) {
3022 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3023 # we need to keep the exact ecost value
3024 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
3025 $order->{unitprice} = $order->{ecost_tax_included};
3028 # The user entered the unit price tax included
3029 $order->{unitprice_tax_included} = $order->{unitprice};
3031 # unit price tax excluded = unit price tax included / ( 1 + tax rate )
3032 $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
3035 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3036 # we need to keep the exact ecost value
3037 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
3038 $order->{unitprice} = $order->{ecost_tax_excluded};
3041 # The user entered the unit price tax excluded
3042 $order->{unitprice_tax_excluded} = $order->{unitprice};
3045 # unit price tax included = unit price tax included * ( 1 + tax rate )
3046 $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
3049 # tax value = quantity * unit price tax excluded * tax rate
3050 $order->{tax_value_on_receiving} = $order->{quantity} * $order->{unitprice_tax_excluded} * $order->{tax_rate_on_receiving};
3056 =head3 GetOrderUsers
3058 $order_users_ids = &GetOrderUsers($ordernumber);
3060 Returns a list of all borrowernumbers that are in order users list
3065 my ($ordernumber) = @_;
3067 return unless $ordernumber;
3070 SELECT borrowernumber
3072 WHERE ordernumber = ?
3074 my $dbh = C4::Context->dbh;
3075 my $sth = $dbh->prepare($query);
3076 $sth->execute($ordernumber);
3077 my $results = $sth->fetchall_arrayref( {} );
3079 my @borrowernumbers;
3080 foreach (@$results) {
3081 push @borrowernumbers, $_->{'borrowernumber'};
3084 return @borrowernumbers;
3087 =head3 ModOrderUsers
3089 my @order_users_ids = (1, 2, 3);
3090 &ModOrderUsers($ordernumber, @basketusers_ids);
3092 Delete all users from order users list, and add users in C<@order_users_ids>
3098 my ( $ordernumber, @order_users_ids ) = @_;
3100 return unless $ordernumber;
3102 my $dbh = C4::Context->dbh;
3104 DELETE FROM aqorder_users
3105 WHERE ordernumber = ?
3107 my $sth = $dbh->prepare($query);
3108 $sth->execute($ordernumber);
3111 INSERT INTO aqorder_users (ordernumber, borrowernumber)
3114 $sth = $dbh->prepare($query);
3115 foreach my $order_user_id (@order_users_ids) {
3116 $sth->execute( $ordernumber, $order_user_id );
3120 sub NotifyOrderUsers {
3121 my ($ordernumber) = @_;
3123 my @borrowernumbers = GetOrderUsers($ordernumber);
3124 return unless @borrowernumbers;
3126 my $order = GetOrder( $ordernumber );
3127 for my $borrowernumber (@borrowernumbers) {
3128 my $patron = Koha::Patrons->find( $borrowernumber );
3129 my $library = $patron->library->unblessed;
3130 my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed;
3131 my $letter = C4::Letters::GetPreparedLetter(
3132 module => 'acquisition',
3133 letter_code => 'ACQ_NOTIF_ON_RECEIV',
3134 branchcode => $library->{branchcode},
3135 lang => $patron->lang,
3137 'branches' => $library,
3138 'borrowers' => $patron->unblessed,
3139 'biblio' => $biblio,
3140 'aqorders' => $order,
3144 C4::Letters::EnqueueLetter(
3147 borrowernumber => $borrowernumber,
3148 LibraryName => C4::Context->preference("LibraryName"),
3149 message_transport_type => 'email',
3151 ) or warn "can't enqueue letter $letter";
3156 =head3 FillWithDefaultValues
3158 FillWithDefaultValues( $marc_record );
3160 This will update the record with default value defined in the ACQ framework.
3161 For all existing fields, if a default value exists and there are no subfield, it will be created.
3162 If the field does not exist, it will be created too.
3166 sub FillWithDefaultValues {
3168 my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3171 C4::Biblio::GetMarcFromKohaField( 'items.itemnumber', '' );
3172 for my $tag ( sort keys %$tagslib ) {
3174 next if $tag == $itemfield;
3175 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3176 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3177 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3178 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3179 my @fields = $record->field($tag);
3181 for my $field (@fields) {
3182 unless ( defined $field->subfield($subfield) ) {
3183 $field->add_subfields(
3184 $subfield => $defaultvalue );
3189 $record->insert_fields_ordered(
3191 $tag, '', '', $subfield => $defaultvalue
3206 Koha Development Team <http://koha-community.org/>