1 package C4::Acquisition;
3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
30 use C4::Log qw(logaction);
31 use C4::Templates qw(gettemplate);
32 use Koha::DateUtils qw( dt_from_string output_pref );
33 use Koha::Acquisition::Baskets;
34 use Koha::Acquisition::Booksellers;
35 use Koha::Acquisition::Orders;
39 use Koha::Number::Price;
41 use Koha::CsvProfiles;
51 use vars qw(@ISA @EXPORT);
57 &GetBasket &NewBasket &ReopenBasket &ModBasket
58 &GetBasketAsCSV &GetBasketGroupAsCSV
59 &GetBasketsByBookseller &GetBasketsByBasketgroup
60 &GetBasketsInfosByBookseller
62 &GetBasketUsers &ModBasketUsers
67 &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup
68 &GetBasketgroups &ReOpenBasketgroup
70 &ModOrder &GetOrder &GetOrders &GetOrdersByBiblionumber
71 &GetOrderFromItemnumber
72 &SearchOrders &GetHistory &GetRecentAcqui
73 &ModReceiveOrder &CancelReceipt
90 &GetBiblioCountByBasketno
96 &FillWithDefaultValues
107 sub GetOrderFromItemnumber {
108 my ($itemnumber) = @_;
109 my $dbh = C4::Context->dbh;
112 SELECT * from aqorders LEFT JOIN aqorders_items
113 ON ( aqorders.ordernumber = aqorders_items.ordernumber )
114 WHERE itemnumber = ? |;
116 my $sth = $dbh->prepare($query);
120 $sth->execute($itemnumber);
122 my $order = $sth->fetchrow_hashref;
129 C4::Acquisition - Koha functions for dealing with orders and acquisitions
137 The functions in this module deal with acquisitions, managing book
138 orders, basket and parcels.
142 =head2 FUNCTIONS ABOUT BASKETS
146 $aqbasket = &GetBasket($basketnumber);
148 get all basket informations in aqbasket for a given basket
150 B<returns:> informations for a given basket returned as a hashref.
156 my $dbh = C4::Context->dbh;
159 concat( b.firstname,' ',b.surname) AS authorisedbyname
161 LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
164 my $sth=$dbh->prepare($query);
165 $sth->execute($basketno);
166 my $basket = $sth->fetchrow_hashref;
170 #------------------------------------------------------------#
174 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
175 $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace, $is_standing, $create_items );
177 Create a new basket in aqbasket table
181 =item C<$booksellerid> is a foreign key in the aqbasket table
183 =item C<$authorizedby> is the username of who created the basket
187 The other parameters are optional, see ModBasketHeader for more info on them.
192 my ( $booksellerid, $authorisedby, $basketname, $basketnote,
193 $basketbooksellernote, $basketcontractnumber, $deliveryplace,
194 $billingplace, $is_standing, $create_items ) = @_;
195 my $dbh = C4::Context->dbh;
197 'INSERT INTO aqbasket (creationdate,booksellerid,authorisedby) '
198 . 'VALUES (now(),?,?)';
199 $dbh->do( $query, {}, $booksellerid, $authorisedby );
201 my $basket = $dbh->{mysql_insertid};
202 $basketname ||= q{}; # default to empty strings
204 $basketbooksellernote ||= q{};
205 ModBasketHeader( $basket, $basketname, $basketnote, $basketbooksellernote,
206 $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items );
208 # Log the basket creation
209 if (C4::Context->preference("AcqLog")) {
210 logaction('ACQUISITIONS', 'ADD_BASKET', $basket);
218 &ReopenBasket($basketno);
226 my $dbh = C4::Context->dbh;
227 $dbh->do( q{UPDATE aqbasket SET closedate=NULL WHERE basketno=?}, {}, $basketno );
231 SET orderstatus = 'new'
233 AND orderstatus NOT IN ( 'complete', 'cancelled' )
236 # Log the basket reopening
237 if (C4::Context->preference("AcqLog")) {
247 #------------------------------------------------------------#
249 =head3 GetBasketAsCSV
251 &GetBasketAsCSV($basketno);
253 Export a basket as CSV
255 $cgi parameter is needed for column name translation
260 my ($basketno, $cgi, $csv_profile_id) = @_;
261 my $basket = GetBasket($basketno);
262 my @orders = GetOrders($basketno);
263 my $contract = GetContract({
264 contractnumber => $basket->{'contractnumber'}
267 my $template = C4::Templates::gettemplate("acqui/csv/basket.tt", "intranet", $cgi);
269 if ($csv_profile_id) {
270 my $csv_profile = Koha::CsvProfiles->find( $csv_profile_id );
271 Koha::Exceptions::ObjectNotFound->throw( 'There is no valid csv profile given') unless $csv_profile;
273 my $csv = Text::CSV_XS->new({'quote_char'=>'"','escape_char'=>'"','sep_char'=>$csv_profile->csv_separator,'binary'=>1});
274 my $csv_profile_content = $csv_profile->content;
275 my ( @headers, @fields );
276 while ( $csv_profile_content =~ /
279 ([^\|]*) # fieldname (table.row or row)
283 my $field = ($2 eq '') ? $1 : $2;
285 $header =~ s/^\s+|\s+$//g; # Trim whitespaces
286 push @headers, $header;
288 $field =~ s/[^\.]*\.{1}//; # Remove the table name if exists.
289 $field =~ s/^\s+|\s+$//g; # Trim whitespaces
290 push @fields, $field;
292 for my $order (@orders) {
294 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
295 my $biblioitem = $biblio->biblioitem;
296 $order = { %$order, %{ $biblioitem->unblessed } };
298 $order = {%$order, %$contract};
300 $order = {%$order, %$basket, %{ $biblio->unblessed }};
301 for my $field (@fields) {
302 push @row, $order->{$field};
306 my $content = join( $csv_profile->csv_separator, @headers ) . "\n";
307 for my $row ( @rows ) {
308 $csv->combine(@$row);
309 my $string = $csv->string;
310 $content .= $string . "\n";
315 foreach my $order (@orders) {
316 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
317 my $biblioitem = $biblio->biblioitem;
319 contractname => $contract->{'contractname'},
320 ordernumber => $order->{'ordernumber'},
321 entrydate => $order->{'entrydate'},
322 isbn => $order->{'isbn'},
323 author => $biblio->author,
324 title => $biblio->title,
325 publicationyear => $biblioitem->publicationyear,
326 publishercode => $biblioitem->publishercode,
327 collectiontitle => $biblioitem->collectiontitle,
328 notes => $order->{'order_vendornote'},
329 quantity => $order->{'quantity'},
330 rrp => $order->{'rrp'},
332 for my $place ( qw( deliveryplace billingplace ) ) {
333 if ( my $library = Koha::Libraries->find( $row->{deliveryplace} ) ) {
334 $row->{$place} = $library->branchname
338 contractname author title publishercode collectiontitle notes
339 deliveryplace billingplace
341 # Double the quotes to not be interpreted as a field end
342 $row->{$_} =~ s/"/""/g if $row->{$_};
348 if(defined $a->{publishercode} and defined $b->{publishercode}) {
349 $a->{publishercode} cmp $b->{publishercode};
353 $template->param(rows => \@rows);
355 return $template->output;
360 =head3 GetBasketGroupAsCSV
362 &GetBasketGroupAsCSV($basketgroupid);
364 Export a basket group as CSV
366 $cgi parameter is needed for column name translation
370 sub GetBasketGroupAsCSV {
371 my ($basketgroupid, $cgi) = @_;
372 my $baskets = GetBasketsByBasketgroup($basketgroupid);
374 my $template = C4::Templates::gettemplate('acqui/csv/basketgroup.tt', 'intranet', $cgi);
377 for my $basket (@$baskets) {
378 my @orders = GetOrders( $basket->{basketno} );
379 my $contract = GetContract({
380 contractnumber => $basket->{contractnumber}
382 my $bookseller = Koha::Acquisition::Booksellers->find( $basket->{booksellerid} );
383 my $basketgroup = GetBasketgroup( $$basket{basketgroupid} );
385 foreach my $order (@orders) {
386 my $biblio = Koha::Biblios->find( $order->{biblionumber} );
387 my $biblioitem = $biblio->biblioitem;
389 clientnumber => $bookseller->accountnumber,
390 basketname => $basket->{basketname},
391 ordernumber => $order->{ordernumber},
392 author => $biblio->author,
393 title => $biblio->title,
394 publishercode => $biblioitem->publishercode,
395 publicationyear => $biblioitem->publicationyear,
396 collectiontitle => $biblioitem->collectiontitle,
397 isbn => $order->{isbn},
398 quantity => $order->{quantity},
399 rrp_tax_included => $order->{rrp_tax_included},
400 rrp_tax_excluded => $order->{rrp_tax_excluded},
401 discount => $bookseller->discount,
402 ecost_tax_included => $order->{ecost_tax_included},
403 ecost_tax_excluded => $order->{ecost_tax_excluded},
404 notes => $order->{order_vendornote},
405 entrydate => $order->{entrydate},
406 booksellername => $bookseller->name,
407 bookselleraddress => $bookseller->address1,
408 booksellerpostal => $bookseller->postal,
409 contractnumber => $contract->{contractnumber},
410 contractname => $contract->{contractname},
413 basketgroupdeliveryplace => $basketgroup->{deliveryplace},
414 basketgroupbillingplace => $basketgroup->{billingplace},
415 basketdeliveryplace => $basket->{deliveryplace},
416 basketbillingplace => $basket->{billingplace},
418 for my $place (qw( basketgroupdeliveryplace basketgroupbillingplace basketdeliveryplace basketbillingplace )) {
419 if ( my $library = Koha::Libraries->find( $temp->{$place} ) ) {
420 $row->{$place} = $library->branchname;
424 basketname author title publishercode collectiontitle notes
425 booksellername bookselleraddress booksellerpostal contractname
426 basketgroupdeliveryplace basketgroupbillingplace
427 basketdeliveryplace basketbillingplace
429 # Double the quotes to not be interpreted as a field end
430 $row->{$_} =~ s/"/""/g if $row->{$_};
435 $template->param(rows => \@rows);
437 return $template->output;
441 =head3 CloseBasketgroup
443 &CloseBasketgroup($basketgroupno);
449 sub CloseBasketgroup {
450 my ($basketgroupno) = @_;
451 my $dbh = C4::Context->dbh;
452 my $sth = $dbh->prepare("
453 UPDATE aqbasketgroups
457 $sth->execute($basketgroupno);
460 #------------------------------------------------------------#
462 =head3 ReOpenBaskergroup($basketgroupno)
464 &ReOpenBaskergroup($basketgroupno);
470 sub ReOpenBasketgroup {
471 my ($basketgroupno) = @_;
472 my $dbh = C4::Context->dbh;
473 my $sth = $dbh->prepare("
474 UPDATE aqbasketgroups
478 $sth->execute($basketgroupno);
481 #------------------------------------------------------------#
485 &ModBasket($basketinfo);
487 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
491 =item C<$basketno> is the primary key of the basket in the aqbasket table.
498 my $basketinfo = shift;
499 my $query = "UPDATE aqbasket SET ";
501 foreach my $key (keys %$basketinfo){
502 if ($key ne 'basketno'){
503 $query .= "$key=?, ";
504 push(@params, $basketinfo->{$key} || undef );
507 # get rid of the "," at the end of $query
508 if (substr($query, length($query)-2) eq ', '){
513 $query .= "WHERE basketno=?";
514 push(@params, $basketinfo->{'basketno'});
515 my $dbh = C4::Context->dbh;
516 my $sth = $dbh->prepare($query);
517 $sth->execute(@params);
519 # Log the basket update
520 if (C4::Context->preference("AcqLog")) {
524 $basketinfo->{'basketno'}
531 #------------------------------------------------------------#
533 =head3 ModBasketHeader
535 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
537 Modifies a basket's header.
541 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
543 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
545 =item C<$note> is the "note" field in the "aqbasket" table;
547 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
549 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
551 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
553 =item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
555 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
557 =item C<$is_standing> is the "is_standing" field in the aqbasket table.
559 =item C<$create_items> should be set to 'ordering', 'receiving' or 'cataloguing' (or undef, in which
560 case the AcqCreateItem syspref takes precedence).
566 sub ModBasketHeader {
567 my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items) = @_;
572 SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=?, is_standing=?, create_items=?
576 my $dbh = C4::Context->dbh;
577 my $sth = $dbh->prepare($query);
578 $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items || undef, $basketno);
580 if ( $contractnumber ) {
581 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
582 my $sth2 = $dbh->prepare($query2);
583 $sth2->execute($contractnumber,$basketno);
586 # Log the basket update
587 if (C4::Context->preference("AcqLog")) {
590 'MODIFY_BASKET_HEADER',
598 #------------------------------------------------------------#
600 =head3 GetBasketsByBookseller
602 @results = &GetBasketsByBookseller($booksellerid, $extra);
604 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
608 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
610 =item C<$extra> is the extra sql parameters, can be
612 $extra->{groupby}: group baskets by column
613 ex. $extra->{groupby} = aqbasket.basketgroupid
614 $extra->{orderby}: order baskets by column
615 $extra->{limit}: limit number of results (can be helpful for pagination)
621 sub GetBasketsByBookseller {
622 my ($booksellerid, $extra) = @_;
623 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
625 if ($extra->{groupby}) {
626 $query .= " GROUP by $extra->{groupby}";
628 if ($extra->{orderby}){
629 $query .= " ORDER by $extra->{orderby}";
631 if ($extra->{limit}){
632 $query .= " LIMIT $extra->{limit}";
635 my $dbh = C4::Context->dbh;
636 my $sth = $dbh->prepare($query);
637 $sth->execute($booksellerid);
638 return $sth->fetchall_arrayref({});
641 =head3 GetBasketsInfosByBookseller
643 my $baskets = GetBasketsInfosByBookseller($supplierid, $allbaskets);
645 The optional second parameter allbaskets is a boolean allowing you to
646 select all baskets from the supplier; by default only active baskets (open or
647 closed but still something to receive) are returned.
649 Returns in a arrayref of hashref all about booksellers baskets, plus:
650 total_biblios: Number of distinct biblios in basket
651 total_items: Number of items in basket
652 expected_items: Number of non-received items in basket
656 sub GetBasketsInfosByBookseller {
657 my ($supplierid, $allbaskets) = @_;
659 return unless $supplierid;
661 my $dbh = C4::Context->dbh;
663 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,
664 SUM(aqorders.quantity) AS total_items,
666 IF ( aqorders.orderstatus = 'cancelled', aqorders.quantity, 0 )
667 ) AS total_items_cancelled,
668 COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
670 IF(aqorders.datereceived IS NULL
671 AND aqorders.datecancellationprinted IS NULL
675 SUM( aqorders.uncertainprice ) AS uncertainprices
677 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
678 WHERE booksellerid = ?};
680 $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";
682 unless ( $allbaskets ) {
683 # Don't show the basket if it's NOT CLOSED or is FULLY RECEIVED
684 $query.=" HAVING (closedate IS NULL OR (
686 IF(aqorders.datereceived IS NULL
687 AND aqorders.datecancellationprinted IS NULL
693 my $sth = $dbh->prepare($query);
694 $sth->execute($supplierid);
695 my $baskets = $sth->fetchall_arrayref({});
697 # Retrieve the number of biblios cancelled
698 my $cancelled_biblios = $dbh->selectall_hashref( q|
699 SELECT COUNT(DISTINCT(biblionumber)) AS total_biblios_cancelled, aqbasket.basketno
701 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
702 WHERE booksellerid = ?
703 AND aqorders.orderstatus = 'cancelled'
704 GROUP BY aqbasket.basketno
705 |, 'basketno', {}, $supplierid );
707 $_->{total_biblios_cancelled} = $cancelled_biblios->{$_->{basketno}}{total_biblios_cancelled} || 0
713 =head3 GetBasketUsers
715 $basketusers_ids = &GetBasketUsers($basketno);
717 Returns a list of all borrowernumbers that are in basket users list
722 my $basketno = shift;
724 return unless $basketno;
727 SELECT borrowernumber
731 my $dbh = C4::Context->dbh;
732 my $sth = $dbh->prepare($query);
733 $sth->execute($basketno);
734 my $results = $sth->fetchall_arrayref( {} );
737 foreach (@$results) {
738 push @borrowernumbers, $_->{'borrowernumber'};
741 return @borrowernumbers;
744 =head3 ModBasketUsers
746 my @basketusers_ids = (1, 2, 3);
747 &ModBasketUsers($basketno, @basketusers_ids);
749 Delete all users from basket users list, and add users in C<@basketusers_ids>
755 my ($basketno, @basketusers_ids) = @_;
757 return unless $basketno;
759 my $dbh = C4::Context->dbh;
761 DELETE FROM aqbasketusers
764 my $sth = $dbh->prepare($query);
765 $sth->execute($basketno);
768 INSERT INTO aqbasketusers (basketno, borrowernumber)
771 $sth = $dbh->prepare($query);
772 foreach my $basketuser_id (@basketusers_ids) {
773 $sth->execute($basketno, $basketuser_id);
776 # Log the basket update
777 if (C4::Context->preference("AcqLog")) {
780 'MODIFY_BASKET_USERS',
788 =head3 CanUserManageBasket
790 my $bool = CanUserManageBasket($borrower, $basket[, $userflags]);
791 my $bool = CanUserManageBasket($borrowernumber, $basketno[, $userflags]);
793 Check if a borrower can manage a basket, according to system preference
794 AcqViewBaskets, user permissions and basket properties (creator, users list,
797 First parameter can be either a borrowernumber or a hashref as returned by
798 Koha::Patron->unblessed
800 Second parameter can be either a basketno or a hashref as returned by
801 C4::Acquisition::GetBasket.
803 The third parameter is optional. If given, it should be a hashref as returned
804 by C4::Auth::getuserflags. If not, getuserflags is called.
806 If user is authorised to manage basket, returns 1.
811 sub CanUserManageBasket {
812 my ($borrower, $basket, $userflags) = @_;
814 if (!ref $borrower) {
815 # FIXME This needs to be replaced
816 # We should not accept both scalar and array
817 # Tests need to be updated
818 $borrower = Koha::Patrons->find( $borrower )->unblessed;
821 $basket = GetBasket($basket);
824 return 0 unless ($basket and $borrower);
826 my $borrowernumber = $borrower->{borrowernumber};
827 my $basketno = $basket->{basketno};
829 my $AcqViewBaskets = C4::Context->preference('AcqViewBaskets');
831 if (!defined $userflags) {
832 my $dbh = C4::Context->dbh;
833 my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE borrowernumber = ?");
834 $sth->execute($borrowernumber);
835 my ($flags) = $sth->fetchrow_array;
838 $userflags = C4::Auth::getuserflags($flags, $borrower->{userid}, $dbh);
841 unless ($userflags->{superlibrarian}
842 || (ref $userflags->{acquisition} && $userflags->{acquisition}->{order_manage_all})
843 || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
845 if (not exists $userflags->{acquisition}) {
849 if ( (ref $userflags->{acquisition} && !$userflags->{acquisition}->{order_manage})
850 || (!ref $userflags->{acquisition} && !$userflags->{acquisition}) ) {
854 if ($AcqViewBaskets eq 'user'
855 && $basket->{authorisedby} != $borrowernumber
856 && ! grep { $borrowernumber eq $_ } GetBasketUsers($basketno)) {
860 if ($AcqViewBaskets eq 'branch' && defined $basket->{branch}
861 && $basket->{branch} ne $borrower->{branchcode}) {
869 #------------------------------------------------------------#
871 =head3 GetBasketsByBasketgroup
873 $baskets = &GetBasketsByBasketgroup($basketgroupid);
875 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
879 sub GetBasketsByBasketgroup {
880 my $basketgroupid = shift;
882 SELECT *, aqbasket.booksellerid as booksellerid
884 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?
886 my $dbh = C4::Context->dbh;
887 my $sth = $dbh->prepare($query);
888 $sth->execute($basketgroupid);
889 return $sth->fetchall_arrayref({});
892 #------------------------------------------------------------#
894 =head3 NewBasketgroup
896 $basketgroupid = NewBasketgroup(\%hashref);
898 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
900 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
902 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
904 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
906 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
908 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
910 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
912 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
914 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
919 my $basketgroupinfo = shift;
920 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
921 my $query = "INSERT INTO aqbasketgroups (";
923 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
924 if ( defined $basketgroupinfo->{$field} ) {
925 $query .= "$field, ";
926 push(@params, $basketgroupinfo->{$field});
929 $query .= "booksellerid) VALUES (";
934 push(@params, $basketgroupinfo->{'booksellerid'});
935 my $dbh = C4::Context->dbh;
936 my $sth = $dbh->prepare($query);
937 $sth->execute(@params);
938 my $basketgroupid = $dbh->{'mysql_insertid'};
939 if( $basketgroupinfo->{'basketlist'} ) {
940 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
941 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
942 my $sth2 = $dbh->prepare($query2);
943 $sth2->execute($basketgroupid, $basketno);
946 return $basketgroupid;
949 #------------------------------------------------------------#
951 =head3 ModBasketgroup
953 ModBasketgroup(\%hashref);
955 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
957 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
959 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
961 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
963 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
965 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
967 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
969 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
971 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
976 my $basketgroupinfo = shift;
977 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
978 my $dbh = C4::Context->dbh;
979 my $query = "UPDATE aqbasketgroups SET ";
981 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
982 if ( defined $basketgroupinfo->{$field} ) {
983 $query .= "$field=?, ";
984 push(@params, $basketgroupinfo->{$field});
989 $query .= " WHERE id=?";
990 push(@params, $basketgroupinfo->{'id'});
991 my $sth = $dbh->prepare($query);
992 $sth->execute(@params);
994 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
995 $sth->execute($basketgroupinfo->{'id'});
997 if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
998 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
999 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
1000 $sth->execute($basketgroupinfo->{'id'}, $basketno);
1006 #------------------------------------------------------------#
1008 =head3 DelBasketgroup
1010 DelBasketgroup($basketgroupid);
1012 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
1016 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
1022 sub DelBasketgroup {
1023 my $basketgroupid = shift;
1024 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1025 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
1026 my $dbh = C4::Context->dbh;
1027 my $sth = $dbh->prepare($query);
1028 $sth->execute($basketgroupid);
1032 #------------------------------------------------------------#
1035 =head2 FUNCTIONS ABOUT ORDERS
1037 =head3 GetBasketgroup
1039 $basketgroup = &GetBasketgroup($basketgroupid);
1041 Returns a reference to the hash containing all information about the basketgroup.
1045 sub GetBasketgroup {
1046 my $basketgroupid = shift;
1047 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1048 my $dbh = C4::Context->dbh;
1049 my $result_set = $dbh->selectall_arrayref(
1050 'SELECT * FROM aqbasketgroups WHERE id=?',
1054 return $result_set->[0]; # id is unique
1057 #------------------------------------------------------------#
1059 =head3 GetBasketgroups
1061 $basketgroups = &GetBasketgroups($booksellerid);
1063 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
1067 sub GetBasketgroups {
1068 my $booksellerid = shift;
1069 die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
1070 my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
1071 my $dbh = C4::Context->dbh;
1072 my $sth = $dbh->prepare($query);
1073 $sth->execute($booksellerid);
1074 return $sth->fetchall_arrayref({});
1077 #------------------------------------------------------------#
1079 =head2 FUNCTIONS ABOUT ORDERS
1083 @orders = &GetOrders( $basketno, { orderby => 'biblio.title', cancelled => 0|1 } );
1085 Looks up the pending (non-cancelled) orders with the given basket
1088 If cancelled is set, only cancelled orders will be returned.
1093 my ( $basketno, $params ) = @_;
1095 return () unless $basketno;
1097 my $orderby = $params->{orderby};
1098 my $cancelled = $params->{cancelled} || 0;
1100 my $dbh = C4::Context->dbh;
1102 SELECT biblio.*,biblioitems.*,
1106 $query .= $cancelled
1108 aqorders_transfers.ordernumber_to AS transferred_to,
1109 aqorders_transfers.timestamp AS transferred_to_timestamp
1112 aqorders_transfers.ordernumber_from AS transferred_from,
1113 aqorders_transfers.timestamp AS transferred_from_timestamp
1117 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1118 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1119 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1121 $query .= $cancelled
1123 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
1126 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1134 $orderby ||= q|biblioitems.publishercode, biblio.title|;
1136 AND datecancellationprinted IS NOT NULL
1141 q|aqorders.datecancellationprinted desc, aqorders.timestamp desc|;
1143 AND datecancellationprinted IS NULL
1147 $query .= " ORDER BY $orderby";
1149 $dbh->selectall_arrayref( $query, { Slice => {} }, $basketno );
1154 #------------------------------------------------------------#
1156 =head3 GetOrdersByBiblionumber
1158 @orders = &GetOrdersByBiblionumber($biblionumber);
1160 Looks up the orders with linked to a specific $biblionumber, including
1161 cancelled orders and received orders.
1164 C<@orders> is an array of references-to-hash, whose keys are the
1165 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
1169 sub GetOrdersByBiblionumber {
1170 my $biblionumber = shift;
1171 return unless $biblionumber;
1172 my $dbh = C4::Context->dbh;
1174 SELECT biblio.*,biblioitems.*,
1178 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1179 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1180 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1181 WHERE aqorders.biblionumber=?
1184 $dbh->selectall_arrayref( $query, { Slice => {} }, $biblionumber );
1185 return @{$result_set};
1189 #------------------------------------------------------------#
1193 $order = &GetOrder($ordernumber);
1195 Looks up an order by order number.
1197 Returns a reference-to-hash describing the order. The keys of
1198 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1203 my ($ordernumber) = @_;
1204 return unless $ordernumber;
1206 my $dbh = C4::Context->dbh;
1207 my $query = qq{SELECT
1211 aqbasket.basketname,
1212 borrowers.branchcode,
1213 biblioitems.publicationyear,
1214 biblio.copyrightdate,
1215 biblioitems.editionstatement,
1219 biblioitems.publishercode,
1220 aqorders.rrp AS unitpricesupplier,
1221 aqorders.ecost AS unitpricelib,
1222 aqbudgets.budget_name AS budget,
1223 aqbooksellers.name AS supplier,
1224 aqbooksellers.id AS supplierid,
1225 biblioitems.publishercode AS publisher,
1226 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1227 DATE(aqbasket.closedate) AS orderdate,
1228 aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity_to_receive,
1229 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1230 DATEDIFF(CURDATE( ),closedate) AS latesince
1231 FROM aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1232 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1233 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1234 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
1235 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1236 WHERE aqorders.basketno = aqbasket.basketno
1239 $dbh->selectall_arrayref( $query, { Slice => {} }, $ordernumber );
1241 # result_set assumed to contain 1 match
1242 return $result_set->[0];
1247 &ModOrder(\%hashref);
1249 Modifies an existing order. Updates the order with order number
1250 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1251 other keys of the hash update the fields with the same name in the aqorders
1252 table of the Koha database.
1257 my $orderinfo = shift;
1259 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '';
1261 my $dbh = C4::Context->dbh;
1264 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1265 $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1267 # delete($orderinfo->{'branchcode'});
1268 # the hash contains a lot of entries not in aqorders, so get the columns ...
1269 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1271 my $colnames = $sth->{NAME};
1272 #FIXME Be careful. If aqorders would have columns with diacritics,
1273 #you should need to decode what you get back from NAME.
1274 #See report 10110 and guided_reports.pl
1275 my $query = "UPDATE aqorders SET ";
1277 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1278 # ... and skip hash entries that are not in the aqorders table
1279 # FIXME : probably not the best way to do it (would be better to have a correct hash)
1280 next unless grep { $_ eq $orderinfokey } @$colnames;
1281 $query .= "$orderinfokey=?, ";
1282 push(@params, $orderinfo->{$orderinfokey});
1285 $query .= "timestamp=NOW() WHERE ordernumber=?";
1286 push(@params, $orderinfo->{'ordernumber'} );
1287 $sth = $dbh->prepare($query);
1288 $sth->execute(@params);
1292 #------------------------------------------------------------#
1296 ModItemOrder($itemnumber, $ordernumber);
1298 Modifies the ordernumber of an item in aqorders_items.
1303 my ($itemnumber, $ordernumber) = @_;
1305 return unless ($itemnumber and $ordernumber);
1307 my $dbh = C4::Context->dbh;
1309 UPDATE aqorders_items
1311 WHERE itemnumber = ?
1313 my $sth = $dbh->prepare($query);
1314 return $sth->execute($ordernumber, $itemnumber);
1317 #------------------------------------------------------------#
1319 =head3 ModReceiveOrder
1321 my ( $date_received, $new_ordernumber ) = ModReceiveOrder(
1323 biblionumber => $biblionumber,
1325 quantityreceived => $quantityreceived,
1327 invoice => $invoice,
1328 budget_id => $budget_id,
1329 datereceived => $datereceived,
1330 received_itemnumbers => \@received_itemnumbers,
1334 Updates an order, to reflect the fact that it was received, at least
1337 If a partial order is received, splits the order into two.
1339 Updates the order with biblionumber C<$biblionumber> and ordernumber
1340 C<$order->{ordernumber}>.
1345 sub ModReceiveOrder {
1347 my $biblionumber = $params->{biblionumber};
1348 my $order = { %{ $params->{order} } }; # Copy the order, we don't want to modify it
1349 my $invoice = $params->{invoice};
1350 my $quantrec = $params->{quantityreceived};
1351 my $user = $params->{user};
1352 my $budget_id = $params->{budget_id};
1353 my $datereceived = $params->{datereceived};
1354 my $received_items = $params->{received_items};
1356 my $dbh = C4::Context->dbh;
1357 $datereceived = output_pref(
1359 dt => ( $datereceived ? dt_from_string( $datereceived ) : dt_from_string ),
1360 dateformat => 'iso',
1365 my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1366 if ($suggestionid) {
1367 ModSuggestion( {suggestionid=>$suggestionid,
1368 STATUS=>'AVAILABLE',
1369 biblionumber=> $biblionumber}
1373 my $result_set = $dbh->selectrow_arrayref(
1374 q{SELECT aqbasket.is_standing
1376 WHERE basketno=?},{ Slice => {} }, $order->{basketno});
1377 my $is_standing = $result_set->[0]; # we assume we have a unique basket
1379 my $new_ordernumber = $order->{ordernumber};
1380 if ( $is_standing || $order->{quantity} > $quantrec ) {
1381 # Split order line in two parts: the first is the original order line
1382 # without received items (the quantity is decreased),
1383 # the second part is a new order line with quantity=quantityrec
1384 # (entirely received)
1388 orderstatus = 'partial'|;
1389 $query .= q| WHERE ordernumber = ?|;
1390 my $sth = $dbh->prepare($query);
1393 ( $is_standing ? 1 : ($order->{quantity} - $quantrec) ),
1394 $order->{ordernumber}
1397 if ( not $order->{subscriptionid} && defined $order->{order_internalnote} ) {
1400 SET order_internalnote = ?
1401 WHERE ordernumber = ?|, {},
1402 $order->{order_internalnote}, $order->{ordernumber}
1406 # Recalculate tax_value
1410 tax_value_on_ordering = quantity * | . get_rounding_sql(q|ecost_tax_excluded|) . q| * tax_rate_on_ordering,
1411 tax_value_on_receiving = quantity * | . get_rounding_sql(q|unitprice_tax_excluded|) . q| * tax_rate_on_receiving
1412 WHERE ordernumber = ?
1413 |, undef, $order->{ordernumber});
1415 delete $order->{ordernumber};
1416 $order->{budget_id} = ( $budget_id || $order->{budget_id} );
1417 $order->{quantity} = $quantrec;
1418 $order->{quantityreceived} = $quantrec;
1419 $order->{ecost_tax_excluded} //= 0;
1420 $order->{tax_rate_on_ordering} //= 0;
1421 $order->{unitprice_tax_excluded} //= 0;
1422 $order->{tax_rate_on_receiving} //= 0;
1423 $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($order->{ecost_tax_excluded}) * $order->{tax_rate_on_ordering};
1424 $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
1425 $order->{datereceived} = $datereceived;
1426 $order->{invoiceid} = $invoice->{invoiceid};
1427 $order->{orderstatus} = 'complete';
1428 $new_ordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber; # TODO What if the store fails?
1430 if ($received_items) {
1431 foreach my $itemnumber (@$received_items) {
1432 ModItemOrder($itemnumber, $new_ordernumber);
1438 SET quantityreceived = ?,
1442 orderstatus = 'complete'
1446 , replacementprice = ?
1447 | if defined $order->{replacementprice};
1450 , unitprice = ?, unitprice_tax_included = ?, unitprice_tax_excluded = ?
1451 | if defined $order->{unitprice};
1454 ,tax_value_on_receiving = ?
1455 | if defined $order->{tax_value_on_receiving};
1458 ,tax_rate_on_receiving = ?
1459 | if defined $order->{tax_rate_on_receiving};
1462 , order_internalnote = ?
1463 | if defined $order->{order_internalnote};
1465 $query .= q| where biblionumber=? and ordernumber=?|;
1467 my $sth = $dbh->prepare( $query );
1468 my @params = ( $quantrec, $datereceived, $invoice->{invoiceid}, ( $budget_id ? $budget_id : $order->{budget_id} ) );
1470 if ( defined $order->{replacementprice} ) {
1471 push @params, $order->{replacementprice};
1474 if ( defined $order->{unitprice} ) {
1475 push @params, $order->{unitprice}, $order->{unitprice_tax_included}, $order->{unitprice_tax_excluded};
1478 if ( defined $order->{tax_value_on_receiving} ) {
1479 push @params, $order->{tax_value_on_receiving};
1482 if ( defined $order->{tax_rate_on_receiving} ) {
1483 push @params, $order->{tax_rate_on_receiving};
1486 if ( defined $order->{order_internalnote} ) {
1487 push @params, $order->{order_internalnote};
1490 push @params, ( $biblionumber, $order->{ordernumber} );
1492 $sth->execute( @params );
1494 # All items have been received, sent a notification to users
1495 NotifyOrderUsers( $order->{ordernumber} );
1498 return ($datereceived, $new_ordernumber);
1501 =head3 CancelReceipt
1503 my $parent_ordernumber = CancelReceipt($ordernumber);
1505 Cancel an order line receipt and update the parent order line, as if no
1507 If items are created at receipt (AcqCreateItem = receiving) then delete
1513 my $ordernumber = shift;
1515 return unless $ordernumber;
1517 my $dbh = C4::Context->dbh;
1519 SELECT datereceived, parent_ordernumber, quantity
1521 WHERE ordernumber = ?
1523 my $sth = $dbh->prepare($query);
1524 $sth->execute($ordernumber);
1525 my $order = $sth->fetchrow_hashref;
1527 warn "CancelReceipt: order $ordernumber does not exist";
1530 unless($order->{'datereceived'}) {
1531 warn "CancelReceipt: order $ordernumber is not received";
1535 my $parent_ordernumber = $order->{'parent_ordernumber'};
1537 my $order_obj = Koha::Acquisition::Orders->find( $ordernumber ); # FIXME rewrite all this subroutine using this object
1538 my @itemnumbers = $order_obj->items->get_column('itemnumber');
1540 if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1541 # The order line has no parent, just mark it as not received
1544 SET quantityreceived = ?,
1547 orderstatus = 'ordered'
1548 WHERE ordernumber = ?
1550 $sth = $dbh->prepare($query);
1551 $sth->execute(0, undef, undef, $ordernumber);
1552 _cancel_items_receipt( $order_obj );
1554 # The order line has a parent, increase parent quantity and delete
1556 unless ( $order_obj->basket->is_standing ) {
1558 SELECT quantity, datereceived
1560 WHERE ordernumber = ?
1562 $sth = $dbh->prepare($query);
1563 $sth->execute($parent_ordernumber);
1564 my $parent_order = $sth->fetchrow_hashref;
1565 unless($parent_order) {
1566 warn "Parent order $parent_ordernumber does not exist.";
1569 if($parent_order->{'datereceived'}) {
1570 warn "CancelReceipt: parent order is received.".
1571 " Can't cancel receipt.";
1577 orderstatus = 'ordered'
1578 WHERE ordernumber = ?
1580 $sth = $dbh->prepare($query);
1581 my $rv = $sth->execute(
1582 $order->{'quantity'} + $parent_order->{'quantity'},
1586 warn "Cannot update parent order line, so do not cancel".
1591 # Recalculate tax_value
1595 tax_value_on_ordering = quantity * | . get_rounding_sql(q|ecost_tax_excluded|) . q| * tax_rate_on_ordering,
1596 tax_value_on_receiving = quantity * | . get_rounding_sql(q|unitprice_tax_excluded|) . q| * tax_rate_on_receiving
1597 WHERE ordernumber = ?
1598 |, undef, $parent_ordernumber);
1601 _cancel_items_receipt( $order_obj, $parent_ordernumber );
1604 DELETE FROM aqorders
1605 WHERE ordernumber = ?
1607 $sth = $dbh->prepare($query);
1608 $sth->execute($ordernumber);
1612 if( $order_obj->basket->effective_create_items eq 'ordering' ) {
1613 my @affects = split q{\|}, C4::Context->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1615 for my $in ( @itemnumbers ) {
1616 my $item = Koha::Items->find( $in ); # FIXME We do not need that, we already have Koha::Items from $order_obj->items
1617 my $biblio = $item->biblio;
1618 my ( $itemfield ) = GetMarcFromKohaField( 'items.itemnumber' );
1619 my $item_marc = C4::Items::GetMarcItem( $biblio->biblionumber, $in );
1620 for my $affect ( @affects ) {
1621 my ( $sf, $v ) = split q{=}, $affect, 2;
1622 foreach ( $item_marc->field($itemfield) ) {
1623 $_->update( $sf => $v );
1626 C4::Items::ModItemFromMarc( $item_marc, $biblio->biblionumber, $in );
1631 return $parent_ordernumber;
1634 sub _cancel_items_receipt {
1635 my ( $order, $parent_ordernumber ) = @_;
1636 $parent_ordernumber ||= $order->ordernumber;
1638 my $items = $order->items;
1639 if ( $order->basket->effective_create_items eq 'receiving' ) {
1640 # Remove items that were created at receipt
1642 DELETE FROM items, aqorders_items
1643 USING items, aqorders_items
1644 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1646 my $dbh = C4::Context->dbh;
1647 my $sth = $dbh->prepare($query);
1648 while ( my $item = $items->next ) {
1649 $sth->execute($item->itemnumber, $item->itemnumber);
1653 while ( my $item = $items->next ) {
1654 ModItemOrder($item->itemnumber, $parent_ordernumber);
1659 #------------------------------------------------------------#
1663 @results = &SearchOrders({
1664 ordernumber => $ordernumber,
1667 booksellerid => $booksellerid,
1668 basketno => $basketno,
1669 basketname => $basketname,
1670 basketgroupname => $basketgroupname,
1674 biblionumber => $biblionumber,
1675 budget_id => $budget_id
1678 Searches for orders filtered by criteria.
1680 C<$ordernumber> Finds matching orders or transferred orders by ordernumber.
1681 C<$search> Finds orders matching %$search% in title, author, or isbn.
1682 C<$owner> Finds order for the logged in user.
1683 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1684 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1687 C<@results> is an array of references-to-hash with the keys are fields
1688 from aqorders, biblio, biblioitems and aqbasket tables.
1693 my ( $params ) = @_;
1694 my $ordernumber = $params->{ordernumber};
1695 my $search = $params->{search};
1696 my $ean = $params->{ean};
1697 my $booksellerid = $params->{booksellerid};
1698 my $basketno = $params->{basketno};
1699 my $basketname = $params->{basketname};
1700 my $basketgroupname = $params->{basketgroupname};
1701 my $owner = $params->{owner};
1702 my $pending = $params->{pending};
1703 my $ordered = $params->{ordered};
1704 my $biblionumber = $params->{biblionumber};
1705 my $budget_id = $params->{budget_id};
1707 my $dbh = C4::Context->dbh;
1710 SELECT aqbasket.basketno,
1712 borrowers.firstname,
1715 biblioitems.biblioitemnumber,
1716 biblioitems.publishercode,
1717 biblioitems.publicationyear,
1718 aqbasket.authorisedby,
1719 aqbasket.booksellerid,
1721 aqbasket.creationdate,
1722 aqbasket.basketname,
1723 aqbasketgroups.id as basketgroupid,
1724 aqbasketgroups.name as basketgroupname,
1727 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1728 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1729 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1730 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1731 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1734 # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
1736 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1740 WHERE (datecancellationprinted is NULL)
1743 if ( $pending or $ordered ) {
1746 ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) )
1748 ( quantity > quantityreceived OR quantityreceived is NULL )
1752 $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1760 my $userenv = C4::Context->userenv;
1761 if ( C4::Context->preference("IndependentBranches") ) {
1762 unless ( C4::Context->IsSuperLibrarian() ) {
1765 borrowers.branchcode = ?
1766 OR borrowers.branchcode = ''
1769 push @args, $userenv->{branch};
1773 if ( $ordernumber ) {
1774 $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1775 push @args, ( $ordernumber, $ordernumber );
1777 if ( $biblionumber ) {
1778 $query .= 'AND aqorders.biblionumber = ?';
1779 push @args, $biblionumber;
1782 $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1783 push @args, ("%$search%","%$search%","%$search%");
1786 $query .= ' AND biblioitems.ean = ?';
1789 if ( $booksellerid ) {
1790 $query .= 'AND aqbasket.booksellerid = ?';
1791 push @args, $booksellerid;
1794 $query .= 'AND aqbasket.basketno = ?';
1795 push @args, $basketno;
1798 $query .= 'AND aqbasket.basketname LIKE ?';
1799 push @args, "%$basketname%";
1801 if( $basketgroupname ) {
1802 $query .= ' AND aqbasketgroups.name LIKE ?';
1803 push @args, "%$basketgroupname%";
1807 $query .= ' AND aqbasket.authorisedby=? ';
1808 push @args, $userenv->{'number'};
1812 $query .= ' AND aqorders.budget_id = ?';
1813 push @args, $budget_id;
1816 $query .= ' ORDER BY aqbasket.basketno';
1818 my $sth = $dbh->prepare($query);
1819 $sth->execute(@args);
1820 return $sth->fetchall_arrayref({});
1823 #------------------------------------------------------------#
1825 =head3 TransferOrder
1827 my $newordernumber = TransferOrder($ordernumber, $basketno);
1829 Transfer an order line to a basket.
1830 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1831 to BOOKSELLER on DATE' and create new order with internal note
1832 'Transferred from BOOKSELLER on DATE'.
1833 Move all attached items to the new order.
1834 Received orders cannot be transferred.
1835 Return the ordernumber of created order.
1840 my ($ordernumber, $basketno) = @_;
1842 return unless ($ordernumber and $basketno);
1844 my $order = Koha::Acquisition::Orders->find( $ordernumber ) or return;
1845 return if $order->datereceived;
1847 $order = $order->unblessed;
1849 my $basket = GetBasket($basketno);
1850 return unless $basket;
1852 my $dbh = C4::Context->dbh;
1853 my ($query, $sth, $rv);
1857 SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1858 WHERE ordernumber = ?
1860 $sth = $dbh->prepare($query);
1861 $rv = $sth->execute('cancelled', $ordernumber);
1863 delete $order->{'ordernumber'};
1864 delete $order->{parent_ordernumber};
1865 $order->{'basketno'} = $basketno;
1867 my $newordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber;
1870 UPDATE aqorders_items
1872 WHERE ordernumber = ?
1874 $sth = $dbh->prepare($query);
1875 $sth->execute($newordernumber, $ordernumber);
1878 INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1881 $sth = $dbh->prepare($query);
1882 $sth->execute($ordernumber, $newordernumber);
1884 return $newordernumber;
1887 =head3 get_rounding_sql
1889 $rounding_sql = get_rounding_sql($column_name);
1891 returns the correct SQL routine based on OrderPriceRounding system preference.
1895 sub get_rounding_sql {
1896 my ( $round_string ) = @_;
1897 my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
1898 if ( $rounding_pref eq "nearest_cent" ) {
1899 return "CAST($round_string*100 AS SIGNED)/100";
1901 return $round_string;
1904 =head3 get_rounded_price
1906 $rounded_price = get_rounded_price( $price );
1908 returns a price rounded as specified in OrderPriceRounding system preference.
1912 sub get_rounded_price {
1914 my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
1915 if( $rounding_pref eq 'nearest_cent' ) {
1916 return Koha::Number::Price->new( $price )->round();
1922 =head2 FUNCTIONS ABOUT PARCELS
1926 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1928 get a lists of parcels.
1935 is the bookseller this function has to get parcels.
1938 To know on what criteria the results list has to be ordered.
1941 is the booksellerinvoicenumber.
1943 =item $datefrom & $dateto
1944 to know on what date this function has to filter its search.
1949 a pointer on a hash list containing parcel informations as such :
1955 =item Last operation
1957 =item Number of biblio
1959 =item Number of items
1966 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1967 my $dbh = C4::Context->dbh;
1968 my @query_params = ();
1970 SELECT aqinvoices.invoicenumber,
1971 datereceived,purchaseordernumber,
1972 count(DISTINCT biblionumber) AS biblio,
1973 sum(quantity) AS itemsexpected,
1974 sum(quantityreceived) AS itemsreceived
1975 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1976 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1977 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1979 push @query_params, $bookseller;
1981 if ( defined $code ) {
1982 $strsth .= ' and aqinvoices.invoicenumber like ? ';
1983 # add a % to the end of the code to allow stemming.
1984 push @query_params, "$code%";
1987 if ( defined $datefrom ) {
1988 $strsth .= ' and datereceived >= ? ';
1989 push @query_params, $datefrom;
1992 if ( defined $dateto ) {
1993 $strsth .= 'and datereceived <= ? ';
1994 push @query_params, $dateto;
1997 $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
1999 # can't use a placeholder to place this column name.
2000 # but, we could probably be checking to make sure it is a column that will be fetched.
2001 $strsth .= "order by $order " if ($order);
2003 my $sth = $dbh->prepare($strsth);
2005 $sth->execute( @query_params );
2006 my $results = $sth->fetchall_arrayref({});
2010 #------------------------------------------------------------#
2014 \@order_loop = GetHistory( %params );
2016 Retreives some acquisition history information
2026 basket - search both basket name and number
2027 booksellerinvoicenumber
2030 orderstatus (note that orderstatus '' will retrieve orders
2031 of any status except cancelled)
2035 get_canceled_order (if set to a true value, cancelled orders will
2039 $order_loop is a list of hashrefs that each look like this:
2041 'author' => 'Twain, Mark',
2043 'biblionumber' => '215',
2045 'creationdate' => 'MM/DD/YYYY',
2046 'datereceived' => undef,
2049 'invoicenumber' => undef,
2051 'ordernumber' => '1',
2053 'quantityreceived' => undef,
2054 'title' => 'The Adventures of Huckleberry Finn',
2055 'managing_library' => 'CPL'
2056 'is_standing' => '1'
2062 # don't run the query if there are no parameters (list would be too long for sure !)
2063 croak "No search params" unless @_;
2065 my $title = $params{title};
2066 my $author = $params{author};
2067 my $isbn = $params{isbn};
2068 my $ean = $params{ean};
2069 my $name = $params{name};
2070 my $from_placed_on = $params{from_placed_on};
2071 my $to_placed_on = $params{to_placed_on};
2072 my $basket = $params{basket};
2073 my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2074 my $basketgroupname = $params{basketgroupname};
2075 my $budget = $params{budget};
2076 my $orderstatus = $params{orderstatus};
2077 my $is_standing = $params{is_standing};
2078 my $biblionumber = $params{biblionumber};
2079 my $get_canceled_order = $params{get_canceled_order} || 0;
2080 my $ordernumber = $params{ordernumber};
2081 my $search_children_too = $params{search_children_too} || 0;
2082 my $created_by = $params{created_by} || [];
2083 my $managing_library = $params{managing_library};
2084 my $ordernumbers = $params{ordernumbers} || [];
2085 my $additional_fields = $params{additional_fields} // [];
2088 my $total_qtyreceived = 0;
2089 my $total_price = 0;
2091 #get variation of isbn
2095 if ( C4::Context->preference("SearchWithISBNVariations") ){
2096 @isbns = C4::Koha::GetVariationsOfISBN( $isbn );
2097 foreach my $isb (@isbns){
2098 push @isbn_params, '?';
2103 push @isbn_params, '?';
2107 my $dbh = C4::Context->dbh;
2110 COALESCE(biblio.title, deletedbiblio.title) AS title,
2111 COALESCE(biblio.author, deletedbiblio.author) AS author,
2112 COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2113 COALESCE(biblioitems.ean, deletedbiblioitems.ean) AS ean,
2115 aqbasket.basketname,
2116 aqbasket.basketgroupid,
2117 aqbasket.authorisedby,
2118 aqbasket.is_standing,
2119 concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2120 branch as managing_library,
2121 aqbasketgroups.name as groupname,
2123 aqbasket.creationdate,
2124 aqorders.datereceived,
2126 aqorders.quantityreceived,
2128 aqorders.ordernumber,
2130 aqinvoices.invoicenumber,
2131 aqbooksellers.id as id,
2132 aqorders.biblionumber,
2133 aqorders.orderstatus,
2134 aqorders.parent_ordernumber,
2135 aqbudgets.budget_name
2137 $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2140 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2141 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2142 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2143 LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2144 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2145 LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2146 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2147 LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2148 LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2149 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2152 $query .= " WHERE 1 ";
2154 unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2155 $query .= " AND datecancellationprinted IS NULL ";
2158 my @query_params = ();
2160 if ( $biblionumber ) {
2161 $query .= " AND biblio.biblionumber = ?";
2162 push @query_params, $biblionumber;
2166 $query .= " AND biblio.title LIKE ? ";
2167 $title =~ s/\s+/%/g;
2168 push @query_params, "%$title%";
2172 $query .= " AND biblio.author LIKE ? ";
2173 push @query_params, "%$author%";
2177 $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2178 foreach my $isb (@isbns){
2179 push @query_params, "%$isb%";
2184 $query .= " AND biblioitems.ean = ? ";
2185 push @query_params, "$ean";
2188 $query .= " AND aqbooksellers.name LIKE ? ";
2189 push @query_params, "%$name%";
2193 $query .= " AND aqbudgets.budget_id = ? ";
2194 push @query_params, "$budget";
2197 if ( $from_placed_on ) {
2198 $query .= " AND creationdate >= ? ";
2199 push @query_params, $from_placed_on;
2202 if ( $to_placed_on ) {
2203 $query .= " AND creationdate <= ? ";
2204 push @query_params, $to_placed_on;
2207 if ( defined $orderstatus and $orderstatus ne '') {
2208 $query .= " AND aqorders.orderstatus = ? ";
2209 push @query_params, "$orderstatus";
2212 if ( $is_standing ) {
2213 $query .= " AND is_standing = ? ";
2214 push @query_params, $is_standing;
2218 if ($basket =~ m/^\d+$/) {
2219 $query .= " AND aqorders.basketno = ? ";
2220 push @query_params, $basket;
2222 $query .= " AND aqbasket.basketname LIKE ? ";
2223 push @query_params, "%$basket%";
2227 if ($booksellerinvoicenumber) {
2228 $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2229 push @query_params, "%$booksellerinvoicenumber%";
2232 if ($basketgroupname) {
2233 $query .= " AND aqbasketgroups.name LIKE ? ";
2234 push @query_params, "%$basketgroupname%";
2238 $query .= " AND (aqorders.ordernumber = ? ";
2239 push @query_params, $ordernumber;
2240 if ($search_children_too) {
2241 $query .= " OR aqorders.parent_ordernumber = ? ";
2242 push @query_params, $ordernumber;
2247 if ( @$created_by ) {
2248 $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2249 push @query_params, @$created_by;
2252 if ( $managing_library ) {
2253 $query .= " AND aqbasket.branch = ? ";
2254 push @query_params, $managing_library;
2257 if ( @$ordernumbers ) {
2258 $query .= ' AND (aqorders.ordernumber IN ( ' . join (',', ('?') x @$ordernumbers ) . '))';
2259 push @query_params, @$ordernumbers;
2261 if ( @$additional_fields ) {
2262 my @baskets = Koha::Acquisition::Baskets->filter_by_additional_fields($additional_fields);
2264 return [] unless @baskets;
2266 # No parameterization because record IDs come directly from DB
2267 $query .= ' AND aqbasket.basketno IN ( ' . join( ',', map { $_->basketno } @baskets ) . ' )';
2270 if ( C4::Context->preference("IndependentBranches") ) {
2271 unless ( C4::Context->IsSuperLibrarian() ) {
2272 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2273 push @query_params, C4::Context->userenv->{branch};
2276 $query .= " ORDER BY id";
2278 return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2281 =head2 GetRecentAcqui
2283 $results = GetRecentAcqui($days);
2285 C<$results> is a ref to a table which contains hashref
2289 sub GetRecentAcqui {
2291 my $dbh = C4::Context->dbh;
2295 ORDER BY timestamp DESC
2298 my $sth = $dbh->prepare($query);
2300 my $results = $sth->fetchall_arrayref({});
2304 #------------------------------------------------------------#
2308 &AddClaim($ordernumber);
2310 Add a claim for an order
2315 my ($ordernumber) = @_;
2316 my $dbh = C4::Context->dbh;
2319 claims_count = claims_count + 1,
2320 claimed_date = CURDATE()
2321 WHERE ordernumber = ?
2323 my $sth = $dbh->prepare($query);
2324 $sth->execute($ordernumber);
2329 my @invoices = GetInvoices(
2330 invoicenumber => $invoicenumber,
2331 supplierid => $supplierid,
2332 suppliername => $suppliername,
2333 shipmentdatefrom => $shipmentdatefrom, # ISO format
2334 shipmentdateto => $shipmentdateto, # ISO format
2335 billingdatefrom => $billingdatefrom, # ISO format
2336 billingdateto => $billingdateto, # ISO format
2337 isbneanissn => $isbn_or_ean_or_issn,
2340 publisher => $publisher,
2341 publicationyear => $publicationyear,
2342 branchcode => $branchcode,
2343 order_by => $order_by
2346 Return a list of invoices that match all given criteria.
2348 $order_by is "column_name (asc|desc)", where column_name is any of
2349 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2350 'shipmentcost', 'shipmentcost_budgetid'.
2352 asc is the default if omitted
2359 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2360 closedate shipmentcost shipmentcost_budgetid);
2362 my $dbh = C4::Context->dbh;
2364 SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
2365 aqbooksellers.name AS suppliername,
2368 aqorders.datereceived IS NOT NULL,
2369 aqorders.biblionumber,
2372 ) AS receivedbiblios,
2375 aqorders.subscriptionid IS NOT NULL,
2376 aqorders.subscriptionid,
2379 ) AS is_linked_to_subscriptions,
2380 SUM(aqorders.quantityreceived) AS receiveditems
2382 LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2383 LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2384 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2385 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2386 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2387 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2388 LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2393 if($args{supplierid}) {
2394 push @bind_strs, " aqinvoices.booksellerid = ? ";
2395 push @bind_args, $args{supplierid};
2397 if($args{invoicenumber}) {
2398 push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2399 push @bind_args, "%$args{invoicenumber}%";
2401 if($args{suppliername}) {
2402 push @bind_strs, " aqbooksellers.name LIKE ? ";
2403 push @bind_args, "%$args{suppliername}%";
2405 if($args{shipmentdatefrom}) {
2406 push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2407 push @bind_args, $args{shipmentdatefrom};
2409 if($args{shipmentdateto}) {
2410 push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2411 push @bind_args, $args{shipmentdateto};
2413 if($args{billingdatefrom}) {
2414 push @bind_strs, " aqinvoices.billingdate >= ? ";
2415 push @bind_args, $args{billingdatefrom};
2417 if($args{billingdateto}) {
2418 push @bind_strs, " aqinvoices.billingdate <= ? ";
2419 push @bind_args, $args{billingdateto};
2421 if($args{isbneanissn}) {
2422 push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2423 push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2426 push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2427 push @bind_args, $args{title};
2430 push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2431 push @bind_args, $args{author};
2433 if($args{publisher}) {
2434 push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2435 push @bind_args, $args{publisher};
2437 if($args{publicationyear}) {
2438 push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2439 push @bind_args, $args{publicationyear}, $args{publicationyear};
2441 if($args{branchcode}) {
2442 push @bind_strs, " borrowers.branchcode = ? ";
2443 push @bind_args, $args{branchcode};
2445 if($args{message_id}) {
2446 push @bind_strs, " aqinvoices.message_id = ? ";
2447 push @bind_args, $args{message_id};
2450 $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2451 $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";
2453 if($args{order_by}) {
2454 my ($column, $direction) = split / /, $args{order_by};
2455 if(grep { $_ eq $column } @columns) {
2456 $direction ||= 'ASC';
2457 $query .= " ORDER BY $column $direction";
2461 my $sth = $dbh->prepare($query);
2462 $sth->execute(@bind_args);
2464 my $results = $sth->fetchall_arrayref({});
2470 my $invoice = GetInvoice($invoiceid);
2472 Get informations about invoice with given $invoiceid
2474 Return a hash filled with aqinvoices.* fields
2479 my ($invoiceid) = @_;
2482 return unless $invoiceid;
2484 my $dbh = C4::Context->dbh;
2490 my $sth = $dbh->prepare($query);
2491 $sth->execute($invoiceid);
2493 $invoice = $sth->fetchrow_hashref;
2497 =head3 GetInvoiceDetails
2499 my $invoice = GetInvoiceDetails($invoiceid)
2501 Return informations about an invoice + the list of related order lines
2503 Orders informations are in $invoice->{orders} (array ref)
2507 sub GetInvoiceDetails {
2508 my ($invoiceid) = @_;
2510 if ( !defined $invoiceid ) {
2511 carp 'GetInvoiceDetails called without an invoiceid';
2515 my $dbh = C4::Context->dbh;
2517 SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2519 LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2522 my $sth = $dbh->prepare($query);
2523 $sth->execute($invoiceid);
2525 my $invoice = $sth->fetchrow_hashref;
2530 biblio.copyrightdate,
2532 biblioitems.publishercode,
2533 biblioitems.publicationyear,
2534 aqbasket.basketname,
2535 aqbasketgroups.id AS basketgroupid,
2536 aqbasketgroups.name AS basketgroupname
2538 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2539 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2540 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2541 LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2544 $sth = $dbh->prepare($query);
2545 $sth->execute($invoiceid);
2546 $invoice->{orders} = $sth->fetchall_arrayref({});
2547 $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2554 my $invoiceid = AddInvoice(
2555 invoicenumber => $invoicenumber,
2556 booksellerid => $booksellerid,
2557 shipmentdate => $shipmentdate,
2558 billingdate => $billingdate,
2559 closedate => $closedate,
2560 shipmentcost => $shipmentcost,
2561 shipmentcost_budgetid => $shipmentcost_budgetid
2564 Create a new invoice and return its id or undef if it fails.
2571 return unless(%invoice and $invoice{invoicenumber});
2573 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2574 closedate shipmentcost shipmentcost_budgetid message_id);
2578 foreach my $key (keys %invoice) {
2579 if(0 < grep { $_ eq $key } @columns) {
2580 push @set_strs, "$key = ?";
2581 push @set_args, ($invoice{$key} || undef);
2587 my $dbh = C4::Context->dbh;
2588 my $query = "INSERT INTO aqinvoices SET ";
2589 $query .= join (",", @set_strs);
2590 my $sth = $dbh->prepare($query);
2591 $rv = $sth->execute(@set_args);
2593 $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2602 invoiceid => $invoiceid, # Mandatory
2603 invoicenumber => $invoicenumber,
2604 booksellerid => $booksellerid,
2605 shipmentdate => $shipmentdate,
2606 billingdate => $billingdate,
2607 closedate => $closedate,
2608 shipmentcost => $shipmentcost,
2609 shipmentcost_budgetid => $shipmentcost_budgetid
2612 Modify an invoice, invoiceid is mandatory.
2614 Return undef if it fails.
2621 return unless(%invoice and $invoice{invoiceid});
2623 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2624 closedate shipmentcost shipmentcost_budgetid);
2628 foreach my $key (keys %invoice) {
2629 if(0 < grep { $_ eq $key } @columns) {
2630 push @set_strs, "$key = ?";
2631 push @set_args, ($invoice{$key} || undef);
2635 my $dbh = C4::Context->dbh;
2636 my $query = "UPDATE aqinvoices SET ";
2637 $query .= join(",", @set_strs);
2638 $query .= " WHERE invoiceid = ?";
2640 my $sth = $dbh->prepare($query);
2641 $sth->execute(@set_args, $invoice{invoiceid});
2646 CloseInvoice($invoiceid);
2650 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2655 my ($invoiceid) = @_;
2657 return unless $invoiceid;
2659 my $dbh = C4::Context->dbh;
2662 SET closedate = CAST(NOW() AS DATE)
2665 my $sth = $dbh->prepare($query);
2666 $sth->execute($invoiceid);
2669 =head3 ReopenInvoice
2671 ReopenInvoice($invoiceid);
2675 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2680 my ($invoiceid) = @_;
2682 return unless $invoiceid;
2684 my $dbh = C4::Context->dbh;
2687 SET closedate = NULL
2690 my $sth = $dbh->prepare($query);
2691 $sth->execute($invoiceid);
2696 DelInvoice($invoiceid);
2698 Delete an invoice if there are no items attached to it.
2703 my ($invoiceid) = @_;
2705 return unless $invoiceid;
2707 my $dbh = C4::Context->dbh;
2713 my $sth = $dbh->prepare($query);
2714 $sth->execute($invoiceid);
2715 my $res = $sth->fetchrow_arrayref;
2716 if ( $res && $res->[0] == 0 ) {
2718 DELETE FROM aqinvoices
2721 my $sth = $dbh->prepare($query);
2722 return ( $sth->execute($invoiceid) > 0 );
2727 =head3 MergeInvoices
2729 MergeInvoices($invoiceid, \@sourceids);
2731 Merge the invoices identified by the IDs in \@sourceids into
2732 the invoice identified by $invoiceid.
2737 my ($invoiceid, $sourceids) = @_;
2739 return unless $invoiceid;
2740 foreach my $sourceid (@$sourceids) {
2741 next if $sourceid == $invoiceid;
2742 my $source = GetInvoiceDetails($sourceid);
2743 foreach my $order (@{$source->{'orders'}}) {
2744 $order->{'invoiceid'} = $invoiceid;
2747 DelInvoice($source->{'invoiceid'});
2752 =head3 GetBiblioCountByBasketno
2754 $biblio_count = &GetBiblioCountByBasketno($basketno);
2756 Looks up the biblio's count that has basketno value $basketno
2762 sub GetBiblioCountByBasketno {
2763 my ($basketno) = @_;
2764 my $dbh = C4::Context->dbh;
2766 SELECT COUNT( DISTINCT( biblionumber ) )
2769 AND datecancellationprinted IS NULL
2772 my $sth = $dbh->prepare($query);
2773 $sth->execute($basketno);
2774 return $sth->fetchrow;
2777 =head3 populate_order_with_prices
2779 $order = populate_order_with_prices({
2780 order => $order #a hashref with the order values
2781 booksellerid => $booksellerid #FIXME - should obtain from order basket
2782 receiving => 1 # boolean representing order stage, should pass only this or ordering
2783 ordering => 1 # boolean representing order stage
2787 Sets calculated values for an order - all values are stored with full precision
2788 regardless of rounding preference except for tax value which is calculated
2789 on rounded values if requested
2791 For ordering the values set are:
2796 tax_value_on_ordering
2797 For receiving the value set are:
2798 unitprice_tax_included
2799 unitprice_tax_excluded
2800 tax_value_on_receiving
2802 Note: When receiving, if the rounded value of the unitprice matches the rounded
2803 value of the ecost then then ecost (full precision) is used.
2805 Returns a hashref of the order
2807 FIXME: Move this to Koha::Acquisition::Order.pm
2811 sub populate_order_with_prices {
2814 my $order = $params->{order};
2815 my $booksellerid = $params->{booksellerid};
2816 return unless $booksellerid;
2818 my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
2820 my $receiving = $params->{receiving};
2821 my $ordering = $params->{ordering};
2822 my $discount = $order->{discount};
2823 $discount /= 100 if $discount > 1;
2826 $order->{tax_rate_on_ordering} //= $order->{tax_rate};
2827 if ( $bookseller->listincgst ) {
2829 # The user entered the prices tax included
2830 $order->{unitprice} += 0;
2831 $order->{unitprice_tax_included} = $order->{unitprice};
2832 $order->{rrp_tax_included} = $order->{rrp};
2834 # price tax excluded = price tax included / ( 1 + tax rate )
2835 $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2836 $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2838 # ecost tax included = rrp tax included ( 1 - discount )
2839 $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
2841 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2842 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2844 # tax value = quantity * ecost tax excluded * tax rate
2845 # we should use the unitprice if included
2846 my $cost_tax_included = $order->{unitprice_tax_included} || $order->{ecost_tax_included};
2847 my $cost_tax_excluded = $order->{unitprice_tax_excluded} || $order->{ecost_tax_excluded};
2848 $order->{tax_value_on_ordering} = ( get_rounded_price($cost_tax_included) - get_rounded_price($cost_tax_excluded) ) * $order->{quantity};
2852 # The user entered the prices tax excluded
2853 $order->{unitprice_tax_excluded} = $order->{unitprice};
2854 $order->{rrp_tax_excluded} = $order->{rrp};
2856 # price tax included = price tax excluded * ( 1 - tax rate )
2857 $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2858 $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2860 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2861 $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2863 # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount ) = ecost tax excluded * ( 1 + tax rate )
2864 $order->{ecost_tax_included} = $order->{ecost_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2866 # tax value = quantity * ecost tax included * tax rate
2867 # we should use the unitprice if included
2868 my $cost_tax_excluded = $order->{unitprice_tax_excluded} || $order->{ecost_tax_excluded};
2869 $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($cost_tax_excluded) * $order->{tax_rate_on_ordering};
2874 $order->{tax_rate_on_receiving} //= $order->{tax_rate};
2875 if ( $bookseller->invoiceincgst ) {
2876 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2877 # we need to keep the exact ecost value
2878 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
2879 $order->{unitprice} = $order->{ecost_tax_included};
2882 # The user entered the unit price tax included
2883 $order->{unitprice_tax_included} = $order->{unitprice};
2885 # unit price tax excluded = unit price tax included / ( 1 + tax rate )
2886 $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
2889 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2890 # we need to keep the exact ecost value
2891 if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
2892 $order->{unitprice} = $order->{ecost_tax_excluded};
2895 # The user entered the unit price tax excluded
2896 $order->{unitprice_tax_excluded} = $order->{unitprice};
2899 # unit price tax included = unit price tax included * ( 1 + tax rate )
2900 $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
2903 # tax value = quantity * unit price tax excluded * tax rate
2904 $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
2910 =head3 GetOrderUsers
2912 $order_users_ids = &GetOrderUsers($ordernumber);
2914 Returns a list of all borrowernumbers that are in order users list
2919 my ($ordernumber) = @_;
2921 return unless $ordernumber;
2924 SELECT borrowernumber
2926 WHERE ordernumber = ?
2928 my $dbh = C4::Context->dbh;
2929 my $sth = $dbh->prepare($query);
2930 $sth->execute($ordernumber);
2931 my $results = $sth->fetchall_arrayref( {} );
2933 my @borrowernumbers;
2934 foreach (@$results) {
2935 push @borrowernumbers, $_->{'borrowernumber'};
2938 return @borrowernumbers;
2941 =head3 ModOrderUsers
2943 my @order_users_ids = (1, 2, 3);
2944 &ModOrderUsers($ordernumber, @basketusers_ids);
2946 Delete all users from order users list, and add users in C<@order_users_ids>
2952 my ( $ordernumber, @order_users_ids ) = @_;
2954 return unless $ordernumber;
2956 my $dbh = C4::Context->dbh;
2958 DELETE FROM aqorder_users
2959 WHERE ordernumber = ?
2961 my $sth = $dbh->prepare($query);
2962 $sth->execute($ordernumber);
2965 INSERT INTO aqorder_users (ordernumber, borrowernumber)
2968 $sth = $dbh->prepare($query);
2969 foreach my $order_user_id (@order_users_ids) {
2970 $sth->execute( $ordernumber, $order_user_id );
2974 sub NotifyOrderUsers {
2975 my ($ordernumber) = @_;
2977 my @borrowernumbers = GetOrderUsers($ordernumber);
2978 return unless @borrowernumbers;
2980 my $order = GetOrder( $ordernumber );
2981 for my $borrowernumber (@borrowernumbers) {
2982 my $patron = Koha::Patrons->find( $borrowernumber );
2983 my $library = $patron->library->unblessed;
2984 my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed;
2985 my $letter = C4::Letters::GetPreparedLetter(
2986 module => 'acquisition',
2987 letter_code => 'ACQ_NOTIF_ON_RECEIV',
2988 branchcode => $library->{branchcode},
2989 lang => $patron->lang,
2991 'branches' => $library,
2992 'borrowers' => $patron->unblessed,
2993 'biblio' => $biblio,
2994 'aqorders' => $order,
2998 C4::Letters::EnqueueLetter(
3001 borrowernumber => $borrowernumber,
3002 LibraryName => C4::Context->preference("LibraryName"),
3003 message_transport_type => 'email',
3005 ) or warn "can't enqueue letter $letter";
3010 =head3 FillWithDefaultValues
3012 FillWithDefaultValues( $marc_record, $params );
3014 This will update the record with default value defined in the ACQ framework.
3015 For all existing fields, if a default value exists and there are no subfield, it will be created.
3016 If the field does not exist, it will be created too.
3018 If the parameter only_mandatory => 1 is passed via $params, only the mandatory
3019 defaults are being applied to the record.
3023 sub FillWithDefaultValues {
3024 my ( $record, $params ) = @_;
3025 my $mandatory = $params->{only_mandatory};
3026 my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3029 C4::Biblio::GetMarcFromKohaField( 'items.itemnumber' );
3030 for my $tag ( sort keys %$tagslib ) {
3032 next if $tag == $itemfield;
3033 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3034 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3035 next if $mandatory && !$tagslib->{$tag}{$subfield}{mandatory};
3036 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3037 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3038 my @fields = $record->field($tag);
3040 for my $field (@fields) {
3041 if ( $field->is_control_field ) {
3042 $field->update($defaultvalue) if not defined $field->data;
3044 elsif ( not defined $field->subfield($subfield) ) {
3045 $field->add_subfields(
3046 $subfield => $defaultvalue );
3051 if ( $tag < 10 ) { # is_control_field
3052 $record->insert_fields_ordered(
3059 $record->insert_fields_ordered(
3061 $tag, '', '', $subfield => $defaultvalue
3077 Koha Development Team <http://koha-community.org/>