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
::Templates
qw(gettemplate);
31 use Koha
::DateUtils
qw( dt_from_string output_pref );
32 use Koha
::Acquisition
::Baskets
;
33 use Koha
::Acquisition
::Booksellers
;
34 use Koha
::Acquisition
::Orders
;
38 use Koha
::Number
::Price
;
40 use Koha
::CsvProfiles
;
50 use vars
qw(@ISA @EXPORT);
56 &GetBasket &NewBasket &CloseBasket &ReopenBasket &DelBasket &ModBasket
57 &GetBasketAsCSV &GetBasketGroupAsCSV
58 &GetBasketsByBookseller &GetBasketsByBasketgroup
59 &GetBasketsInfosByBookseller
61 &GetBasketUsers &ModBasketUsers
66 &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup
67 &GetBasketgroups &ReOpenBasketgroup
69 &DelOrder &ModOrder &GetOrder &GetOrders &GetOrdersByBiblionumber
70 &GetOrderFromItemnumber
71 &SearchOrders &GetHistory &GetRecentAcqui
72 &ModReceiveOrder &CancelReceipt
89 &GetBiblioCountByBasketno
95 &FillWithDefaultValues
106 sub GetOrderFromItemnumber
{
107 my ($itemnumber) = @_;
108 my $dbh = C4
::Context
->dbh;
111 SELECT
* from aqorders LEFT JOIN aqorders_items
112 ON
( aqorders
.ordernumber
= aqorders_items
.ordernumber
)
113 WHERE itemnumber
= ?
|;
115 my $sth = $dbh->prepare($query);
119 $sth->execute($itemnumber);
121 my $order = $sth->fetchrow_hashref;
128 C4::Acquisition - Koha functions for dealing with orders and acquisitions
136 The functions in this module deal with acquisitions, managing book
137 orders, basket and parcels.
141 =head2 FUNCTIONS ABOUT BASKETS
145 $aqbasket = &GetBasket($basketnumber);
147 get all basket informations in aqbasket for a given basket
149 B<returns:> informations for a given basket returned as a hashref.
155 my $dbh = C4
::Context
->dbh;
158 concat( b.firstname,' ',b.surname) AS authorisedbyname
160 LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
163 my $sth=$dbh->prepare($query);
164 $sth->execute($basketno);
165 my $basket = $sth->fetchrow_hashref;
169 #------------------------------------------------------------#
173 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
174 $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace, $is_standing, $create_items );
176 Create a new basket in aqbasket table
180 =item C<$booksellerid> is a foreign key in the aqbasket table
182 =item C<$authorizedby> is the username of who created the basket
186 The other parameters are optional, see ModBasketHeader for more info on them.
191 my ( $booksellerid, $authorisedby, $basketname, $basketnote,
192 $basketbooksellernote, $basketcontractnumber, $deliveryplace,
193 $billingplace, $is_standing, $create_items ) = @_;
194 my $dbh = C4
::Context
->dbh;
196 'INSERT INTO aqbasket (creationdate,booksellerid,authorisedby) '
197 . 'VALUES (now(),?,?)';
198 $dbh->do( $query, {}, $booksellerid, $authorisedby );
200 my $basket = $dbh->{mysql_insertid
};
201 $basketname ||= q{}; # default to empty strings
203 $basketbooksellernote ||= q{};
204 ModBasketHeader
( $basket, $basketname, $basketnote, $basketbooksellernote,
205 $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items );
209 #------------------------------------------------------------#
213 &CloseBasket($basketno);
215 close a basket (becomes unmodifiable, except for receives)
221 my $dbh = C4
::Context
->dbh;
222 $dbh->do('UPDATE aqbasket SET closedate=now() WHERE basketno=?', {}, $basketno );
225 q{UPDATE aqorders SET orderstatus = 'ordered' WHERE basketno = ? AND orderstatus NOT IN ( 'complete', 'cancelled')},
233 &ReopenBasket($basketno);
241 my $dbh = C4
::Context
->dbh;
242 $dbh->do( q{UPDATE aqbasket SET closedate=NULL WHERE basketno=?}, {}, $basketno );
246 SET orderstatus = 'new'
248 AND orderstatus NOT IN ( 'complete', 'cancelled' )
253 #------------------------------------------------------------#
255 =head3 GetBasketAsCSV
257 &GetBasketAsCSV($basketno);
259 Export a basket as CSV
261 $cgi parameter is needed for column name translation
266 my ($basketno, $cgi, $csv_profile_id) = @_;
267 my $basket = GetBasket
($basketno);
268 my @orders = GetOrders
($basketno);
269 my $contract = GetContract
({
270 contractnumber
=> $basket->{'contractnumber'}
273 my $template = C4
::Templates
::gettemplate
("acqui/csv/basket.tt", "intranet", $cgi);
275 if ($csv_profile_id) {
276 my $csv_profile = Koha
::CsvProfiles
->find( $csv_profile_id );
277 Koha
::Exceptions
::ObjectNotFound
->throw( 'There is no valid csv profile given') unless $csv_profile;
279 my $csv = Text
::CSV_XS
->new({'quote_char'=>'"','escape_char'=>'"','sep_char'=>$csv_profile->csv_separator,'binary'=>1});
280 my $csv_profile_content = $csv_profile->content;
281 my ( @headers, @fields );
282 while ( $csv_profile_content =~ /
285 ([^\
|]*) # fieldname (table.row or row)
289 my $field = ($2 eq '') ?
$1 : $2;
291 $header =~ s/^\s+|\s+$//g; # Trim whitespaces
292 push @headers, $header;
294 $field =~ s/[^\.]*\.{1}//; # Remove the table name if exists.
295 $field =~ s/^\s+|\s+$//g; # Trim whitespaces
296 push @fields, $field;
298 for my $order (@orders) {
300 my $biblio = Koha
::Biblios
->find( $order->{biblionumber
} );
301 my $biblioitem = $biblio->biblioitem;
302 $order = { %$order, %{ $biblioitem->unblessed } };
304 $order = {%$order, %$contract};
306 $order = {%$order, %$basket, %{ $biblio->unblessed }};
307 for my $field (@fields) {
308 push @row, $order->{$field};
312 my $content = join( $csv_profile->csv_separator, @headers ) . "\n";
313 for my $row ( @rows ) {
314 $csv->combine(@
$row);
315 my $string = $csv->string;
316 $content .= $string . "\n";
321 foreach my $order (@orders) {
322 my $biblio = Koha
::Biblios
->find( $order->{biblionumber
} );
323 my $biblioitem = $biblio->biblioitem;
325 contractname
=> $contract->{'contractname'},
326 ordernumber
=> $order->{'ordernumber'},
327 entrydate
=> $order->{'entrydate'},
328 isbn
=> $order->{'isbn'},
329 author
=> $biblio->author,
330 title
=> $biblio->title,
331 publicationyear
=> $biblioitem->publicationyear,
332 publishercode
=> $biblioitem->publishercode,
333 collectiontitle
=> $biblioitem->collectiontitle,
334 notes
=> $order->{'order_vendornote'},
335 quantity
=> $order->{'quantity'},
336 rrp
=> $order->{'rrp'},
338 for my $place ( qw( deliveryplace billingplace ) ) {
339 if ( my $library = Koha
::Libraries
->find( $row->{deliveryplace
} ) ) {
340 $row->{$place} = $library->branchname
344 contractname author title publishercode collectiontitle notes
345 deliveryplace billingplace
347 # Double the quotes to not be interpreted as a field end
348 $row->{$_} =~ s/"/""/g if $row->{$_};
354 if(defined $a->{publishercode
} and defined $b->{publishercode
}) {
355 $a->{publishercode
} cmp $b->{publishercode
};
359 $template->param(rows
=> \
@rows);
361 return $template->output;
366 =head3 GetBasketGroupAsCSV
368 &GetBasketGroupAsCSV($basketgroupid);
370 Export a basket group as CSV
372 $cgi parameter is needed for column name translation
376 sub GetBasketGroupAsCSV
{
377 my ($basketgroupid, $cgi) = @_;
378 my $baskets = GetBasketsByBasketgroup
($basketgroupid);
380 my $template = C4
::Templates
::gettemplate
('acqui/csv/basketgroup.tt', 'intranet', $cgi);
383 for my $basket (@
$baskets) {
384 my @orders = GetOrders
( $basket->{basketno
} );
385 my $contract = GetContract
({
386 contractnumber
=> $basket->{contractnumber
}
388 my $bookseller = Koha
::Acquisition
::Booksellers
->find( $basket->{booksellerid
} );
389 my $basketgroup = GetBasketgroup
( $$basket{basketgroupid
} );
391 foreach my $order (@orders) {
392 my $biblio = Koha
::Biblios
->find( $order->{biblionumber
} );
393 my $biblioitem = $biblio->biblioitem;
395 clientnumber
=> $bookseller->accountnumber,
396 basketname
=> $basket->{basketname
},
397 ordernumber
=> $order->{ordernumber
},
398 author
=> $biblio->author,
399 title
=> $biblio->title,
400 publishercode
=> $biblioitem->publishercode,
401 publicationyear
=> $biblioitem->publicationyear,
402 collectiontitle
=> $biblioitem->collectiontitle,
403 isbn
=> $order->{isbn
},
404 quantity
=> $order->{quantity
},
405 rrp_tax_included
=> $order->{rrp_tax_included
},
406 rrp_tax_excluded
=> $order->{rrp_tax_excluded
},
407 discount
=> $bookseller->discount,
408 ecost_tax_included
=> $order->{ecost_tax_included
},
409 ecost_tax_excluded
=> $order->{ecost_tax_excluded
},
410 notes
=> $order->{order_vendornote
},
411 entrydate
=> $order->{entrydate
},
412 booksellername
=> $bookseller->name,
413 bookselleraddress
=> $bookseller->address1,
414 booksellerpostal
=> $bookseller->postal,
415 contractnumber
=> $contract->{contractnumber
},
416 contractname
=> $contract->{contractname
},
419 basketgroupdeliveryplace
=> $basketgroup->{deliveryplace
},
420 basketgroupbillingplace
=> $basketgroup->{billingplace
},
421 basketdeliveryplace
=> $basket->{deliveryplace
},
422 basketbillingplace
=> $basket->{billingplace
},
424 for my $place (qw( basketgroupdeliveryplace basketgroupbillingplace basketdeliveryplace basketbillingplace )) {
425 if ( my $library = Koha
::Libraries
->find( $temp->{$place} ) ) {
426 $row->{$place} = $library->branchname;
430 basketname author title publishercode collectiontitle notes
431 booksellername bookselleraddress booksellerpostal contractname
432 basketgroupdeliveryplace basketgroupbillingplace
433 basketdeliveryplace basketbillingplace
435 # Double the quotes to not be interpreted as a field end
436 $row->{$_} =~ s/"/""/g if $row->{$_};
441 $template->param(rows
=> \
@rows);
443 return $template->output;
447 =head3 CloseBasketgroup
449 &CloseBasketgroup($basketgroupno);
455 sub CloseBasketgroup
{
456 my ($basketgroupno) = @_;
457 my $dbh = C4
::Context
->dbh;
458 my $sth = $dbh->prepare("
459 UPDATE aqbasketgroups
463 $sth->execute($basketgroupno);
466 #------------------------------------------------------------#
468 =head3 ReOpenBaskergroup($basketgroupno)
470 &ReOpenBaskergroup($basketgroupno);
476 sub ReOpenBasketgroup
{
477 my ($basketgroupno) = @_;
478 my $dbh = C4
::Context
->dbh;
479 my $sth = $dbh->prepare("
480 UPDATE aqbasketgroups
484 $sth->execute($basketgroupno);
487 #------------------------------------------------------------#
492 &DelBasket($basketno);
494 Deletes the basket that has basketno field $basketno in the aqbasket table.
498 =item C<$basketno> is the primary key of the basket in the aqbasket table.
505 my ( $basketno ) = @_;
506 my $query = "DELETE FROM aqbasket WHERE basketno=?";
507 my $dbh = C4
::Context
->dbh;
508 my $sth = $dbh->prepare($query);
509 $sth->execute($basketno);
513 #------------------------------------------------------------#
517 &ModBasket($basketinfo);
519 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
523 =item C<$basketno> is the primary key of the basket in the aqbasket table.
530 my $basketinfo = shift;
531 my $query = "UPDATE aqbasket SET ";
533 foreach my $key (keys %$basketinfo){
534 if ($key ne 'basketno'){
535 $query .= "$key=?, ";
536 push(@params, $basketinfo->{$key} || undef );
539 # get rid of the "," at the end of $query
540 if (substr($query, length($query)-2) eq ', '){
545 $query .= "WHERE basketno=?";
546 push(@params, $basketinfo->{'basketno'});
547 my $dbh = C4
::Context
->dbh;
548 my $sth = $dbh->prepare($query);
549 $sth->execute(@params);
554 #------------------------------------------------------------#
556 =head3 ModBasketHeader
558 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
560 Modifies a basket's header.
564 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
566 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
568 =item C<$note> is the "note" field in the "aqbasket" table;
570 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
572 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
574 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
576 =item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
578 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
580 =item C<$is_standing> is the "is_standing" field in the aqbasket table.
582 =item C<$create_items> should be set to 'ordering', 'receiving' or 'cataloguing' (or undef, in which
583 case the AcqCreateItem syspref takes precedence).
589 sub ModBasketHeader
{
590 my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items) = @_;
595 SET basketname
=?
, note
=?
, booksellernote
=?
, booksellerid
=?
, deliveryplace
=?
, billingplace
=?
, is_standing
=?
, create_items
=?
599 my $dbh = C4
::Context
->dbh;
600 my $sth = $dbh->prepare($query);
601 $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items || undef, $basketno);
603 if ( $contractnumber ) {
604 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
605 my $sth2 = $dbh->prepare($query2);
606 $sth2->execute($contractnumber,$basketno);
611 #------------------------------------------------------------#
613 =head3 GetBasketsByBookseller
615 @results = &GetBasketsByBookseller($booksellerid, $extra);
617 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
621 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
623 =item C<$extra> is the extra sql parameters, can be
625 $extra->{groupby}: group baskets by column
626 ex. $extra->{groupby} = aqbasket.basketgroupid
627 $extra->{orderby}: order baskets by column
628 $extra->{limit}: limit number of results (can be helpful for pagination)
634 sub GetBasketsByBookseller
{
635 my ($booksellerid, $extra) = @_;
636 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
638 if ($extra->{groupby
}) {
639 $query .= " GROUP by $extra->{groupby}";
641 if ($extra->{orderby
}){
642 $query .= " ORDER by $extra->{orderby}";
644 if ($extra->{limit
}){
645 $query .= " LIMIT $extra->{limit}";
648 my $dbh = C4
::Context
->dbh;
649 my $sth = $dbh->prepare($query);
650 $sth->execute($booksellerid);
651 return $sth->fetchall_arrayref({});
654 =head3 GetBasketsInfosByBookseller
656 my $baskets = GetBasketsInfosByBookseller($supplierid, $allbaskets);
658 The optional second parameter allbaskets is a boolean allowing you to
659 select all baskets from the supplier; by default only active baskets (open or
660 closed but still something to receive) are returned.
662 Returns in a arrayref of hashref all about booksellers baskets, plus:
663 total_biblios: Number of distinct biblios in basket
664 total_items: Number of items in basket
665 expected_items: Number of non-received items in basket
669 sub GetBasketsInfosByBookseller
{
670 my ($supplierid, $allbaskets) = @_;
672 return unless $supplierid;
674 my $dbh = C4
::Context
->dbh;
676 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,
677 SUM(aqorders.quantity) AS total_items,
679 IF ( aqorders.orderstatus = 'cancelled', aqorders.quantity, 0 )
680 ) AS total_items_cancelled,
681 COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
683 IF(aqorders.datereceived IS NULL
684 AND aqorders.datecancellationprinted IS NULL
688 SUM( aqorders.uncertainprice ) AS uncertainprices
690 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
691 WHERE booksellerid = ?};
693 $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";
695 unless ( $allbaskets ) {
696 # Don't show the basket if it's NOT CLOSED or is FULLY RECEIVED
697 $query.=" HAVING (closedate IS NULL OR (
699 IF(aqorders.datereceived IS NULL
700 AND aqorders.datecancellationprinted IS NULL
706 my $sth = $dbh->prepare($query);
707 $sth->execute($supplierid);
708 my $baskets = $sth->fetchall_arrayref({});
710 # Retrieve the number of biblios cancelled
711 my $cancelled_biblios = $dbh->selectall_hashref( q
|
712 SELECT COUNT
(DISTINCT
(biblionumber
)) AS total_biblios_cancelled
, aqbasket
.basketno
714 LEFT JOIN aqorders ON aqorders
.basketno
= aqbasket
.basketno
715 WHERE booksellerid
= ?
716 AND aqorders
.orderstatus
= 'cancelled'
717 GROUP BY aqbasket
.basketno
718 |, 'basketno', {}, $supplierid );
720 $_->{total_biblios_cancelled
} = $cancelled_biblios->{$_->{basketno
}}{total_biblios_cancelled
} || 0
726 =head3 GetBasketUsers
728 $basketusers_ids = &GetBasketUsers($basketno);
730 Returns a list of all borrowernumbers that are in basket users list
735 my $basketno = shift;
737 return unless $basketno;
740 SELECT borrowernumber
744 my $dbh = C4
::Context
->dbh;
745 my $sth = $dbh->prepare($query);
746 $sth->execute($basketno);
747 my $results = $sth->fetchall_arrayref( {} );
750 foreach (@
$results) {
751 push @borrowernumbers, $_->{'borrowernumber'};
754 return @borrowernumbers;
757 =head3 ModBasketUsers
759 my @basketusers_ids = (1, 2, 3);
760 &ModBasketUsers($basketno, @basketusers_ids);
762 Delete all users from basket users list, and add users in C<@basketusers_ids>
768 my ($basketno, @basketusers_ids) = @_;
770 return unless $basketno;
772 my $dbh = C4
::Context
->dbh;
774 DELETE FROM aqbasketusers
777 my $sth = $dbh->prepare($query);
778 $sth->execute($basketno);
781 INSERT INTO aqbasketusers
(basketno
, borrowernumber
)
784 $sth = $dbh->prepare($query);
785 foreach my $basketuser_id (@basketusers_ids) {
786 $sth->execute($basketno, $basketuser_id);
791 =head3 CanUserManageBasket
793 my $bool = CanUserManageBasket($borrower, $basket[, $userflags]);
794 my $bool = CanUserManageBasket($borrowernumber, $basketno[, $userflags]);
796 Check if a borrower can manage a basket, according to system preference
797 AcqViewBaskets, user permissions and basket properties (creator, users list,
800 First parameter can be either a borrowernumber or a hashref as returned by
801 Koha::Patron->unblessed
803 Second parameter can be either a basketno or a hashref as returned by
804 C4::Acquisition::GetBasket.
806 The third parameter is optional. If given, it should be a hashref as returned
807 by C4::Auth::getuserflags. If not, getuserflags is called.
809 If user is authorised to manage basket, returns 1.
814 sub CanUserManageBasket
{
815 my ($borrower, $basket, $userflags) = @_;
817 if (!ref $borrower) {
818 # FIXME This needs to be replaced
819 # We should not accept both scalar and array
820 # Tests need to be updated
821 $borrower = Koha
::Patrons
->find( $borrower )->unblessed;
824 $basket = GetBasket
($basket);
827 return 0 unless ($basket and $borrower);
829 my $borrowernumber = $borrower->{borrowernumber
};
830 my $basketno = $basket->{basketno
};
832 my $AcqViewBaskets = C4
::Context
->preference('AcqViewBaskets');
834 if (!defined $userflags) {
835 my $dbh = C4
::Context
->dbh;
836 my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE borrowernumber = ?");
837 $sth->execute($borrowernumber);
838 my ($flags) = $sth->fetchrow_array;
841 $userflags = C4
::Auth
::getuserflags
($flags, $borrower->{userid
}, $dbh);
844 unless ($userflags->{superlibrarian
}
845 || (ref $userflags->{acquisition
} && $userflags->{acquisition
}->{order_manage_all
})
846 || (!ref $userflags->{acquisition
} && $userflags->{acquisition
}))
848 if (not exists $userflags->{acquisition
}) {
852 if ( (ref $userflags->{acquisition
} && !$userflags->{acquisition
}->{order_manage
})
853 || (!ref $userflags->{acquisition
} && !$userflags->{acquisition
}) ) {
857 if ($AcqViewBaskets eq 'user'
858 && $basket->{authorisedby
} != $borrowernumber
859 && ! grep { $borrowernumber eq $_ } GetBasketUsers
($basketno)) {
863 if ($AcqViewBaskets eq 'branch' && defined $basket->{branch
}
864 && $basket->{branch
} ne $borrower->{branchcode
}) {
872 #------------------------------------------------------------#
874 =head3 GetBasketsByBasketgroup
876 $baskets = &GetBasketsByBasketgroup($basketgroupid);
878 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
882 sub GetBasketsByBasketgroup
{
883 my $basketgroupid = shift;
885 SELECT
*, aqbasket
.booksellerid as booksellerid
887 LEFT JOIN aqcontract USING
(contractnumber
) WHERE basketgroupid
=?
889 my $dbh = C4
::Context
->dbh;
890 my $sth = $dbh->prepare($query);
891 $sth->execute($basketgroupid);
892 return $sth->fetchall_arrayref({});
895 #------------------------------------------------------------#
897 =head3 NewBasketgroup
899 $basketgroupid = NewBasketgroup(\%hashref);
901 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
903 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
905 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
907 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
909 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
911 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
913 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
915 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
917 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
922 my $basketgroupinfo = shift;
923 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
924 my $query = "INSERT INTO aqbasketgroups (";
926 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
927 if ( defined $basketgroupinfo->{$field} ) {
928 $query .= "$field, ";
929 push(@params, $basketgroupinfo->{$field});
932 $query .= "booksellerid) VALUES (";
937 push(@params, $basketgroupinfo->{'booksellerid'});
938 my $dbh = C4
::Context
->dbh;
939 my $sth = $dbh->prepare($query);
940 $sth->execute(@params);
941 my $basketgroupid = $dbh->{'mysql_insertid'};
942 if( $basketgroupinfo->{'basketlist'} ) {
943 foreach my $basketno (@
{$basketgroupinfo->{'basketlist'}}) {
944 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
945 my $sth2 = $dbh->prepare($query2);
946 $sth2->execute($basketgroupid, $basketno);
949 return $basketgroupid;
952 #------------------------------------------------------------#
954 =head3 ModBasketgroup
956 ModBasketgroup(\%hashref);
958 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
960 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
962 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
964 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
966 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
968 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
970 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
972 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
974 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
979 my $basketgroupinfo = shift;
980 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
981 my $dbh = C4
::Context
->dbh;
982 my $query = "UPDATE aqbasketgroups SET ";
984 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
985 if ( defined $basketgroupinfo->{$field} ) {
986 $query .= "$field=?, ";
987 push(@params, $basketgroupinfo->{$field});
992 $query .= " WHERE id=?";
993 push(@params, $basketgroupinfo->{'id'});
994 my $sth = $dbh->prepare($query);
995 $sth->execute(@params);
997 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
998 $sth->execute($basketgroupinfo->{'id'});
1000 if($basketgroupinfo->{'basketlist'} && @
{$basketgroupinfo->{'basketlist'}}){
1001 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
1002 foreach my $basketno (@
{$basketgroupinfo->{'basketlist'}}) {
1003 $sth->execute($basketgroupinfo->{'id'}, $basketno);
1009 #------------------------------------------------------------#
1011 =head3 DelBasketgroup
1013 DelBasketgroup($basketgroupid);
1015 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
1019 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
1025 sub DelBasketgroup
{
1026 my $basketgroupid = shift;
1027 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1028 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
1029 my $dbh = C4
::Context
->dbh;
1030 my $sth = $dbh->prepare($query);
1031 $sth->execute($basketgroupid);
1035 #------------------------------------------------------------#
1038 =head2 FUNCTIONS ABOUT ORDERS
1040 =head3 GetBasketgroup
1042 $basketgroup = &GetBasketgroup($basketgroupid);
1044 Returns a reference to the hash containing all information about the basketgroup.
1048 sub GetBasketgroup
{
1049 my $basketgroupid = shift;
1050 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1051 my $dbh = C4
::Context
->dbh;
1052 my $result_set = $dbh->selectall_arrayref(
1053 'SELECT * FROM aqbasketgroups WHERE id=?',
1057 return $result_set->[0]; # id is unique
1060 #------------------------------------------------------------#
1062 =head3 GetBasketgroups
1064 $basketgroups = &GetBasketgroups($booksellerid);
1066 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
1070 sub GetBasketgroups
{
1071 my $booksellerid = shift;
1072 die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
1073 my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
1074 my $dbh = C4
::Context
->dbh;
1075 my $sth = $dbh->prepare($query);
1076 $sth->execute($booksellerid);
1077 return $sth->fetchall_arrayref({});
1080 #------------------------------------------------------------#
1082 =head2 FUNCTIONS ABOUT ORDERS
1086 @orders = &GetOrders( $basketno, { orderby => 'biblio.title', cancelled => 0|1 } );
1088 Looks up the pending (non-cancelled) orders with the given basket
1091 If cancelled is set, only cancelled orders will be returned.
1096 my ( $basketno, $params ) = @_;
1098 return () unless $basketno;
1100 my $orderby = $params->{orderby
};
1101 my $cancelled = $params->{cancelled
} || 0;
1103 my $dbh = C4
::Context
->dbh;
1105 SELECT biblio
.*,biblioitems
.*,
1109 $query .= $cancelled
1111 aqorders_transfers
.ordernumber_to AS transferred_to
,
1112 aqorders_transfers
.timestamp AS transferred_to_timestamp
1115 aqorders_transfers
.ordernumber_from AS transferred_from
,
1116 aqorders_transfers
.timestamp AS transferred_from_timestamp
1120 LEFT JOIN aqbudgets ON aqbudgets
.budget_id
= aqorders
.budget_id
1121 LEFT JOIN biblio ON biblio
.biblionumber
= aqorders
.biblionumber
1122 LEFT JOIN biblioitems ON biblioitems
.biblionumber
=biblio
.biblionumber
1124 $query .= $cancelled
1126 LEFT JOIN aqorders_transfers ON aqorders_transfers
.ordernumber_from
= aqorders
.ordernumber
1129 LEFT JOIN aqorders_transfers ON aqorders_transfers
.ordernumber_to
= aqorders
.ordernumber
1137 $orderby ||= q
|biblioitems
.publishercode
, biblio
.title
|;
1139 AND datecancellationprinted IS NOT NULL
1144 q
|aqorders
.datecancellationprinted desc
, aqorders
.timestamp desc
|;
1146 AND datecancellationprinted IS NULL
1150 $query .= " ORDER BY $orderby";
1152 $dbh->selectall_arrayref( $query, { Slice
=> {} }, $basketno );
1157 #------------------------------------------------------------#
1159 =head3 GetOrdersByBiblionumber
1161 @orders = &GetOrdersByBiblionumber($biblionumber);
1163 Looks up the orders with linked to a specific $biblionumber, including
1164 cancelled orders and received orders.
1167 C<@orders> is an array of references-to-hash, whose keys are the
1168 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
1172 sub GetOrdersByBiblionumber
{
1173 my $biblionumber = shift;
1174 return unless $biblionumber;
1175 my $dbh = C4
::Context
->dbh;
1177 SELECT biblio.*,biblioitems.*,
1181 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1182 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1183 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1184 WHERE aqorders.biblionumber=?
1187 $dbh->selectall_arrayref( $query, { Slice
=> {} }, $biblionumber );
1188 return @
{$result_set};
1192 #------------------------------------------------------------#
1196 $order = &GetOrder($ordernumber);
1198 Looks up an order by order number.
1200 Returns a reference-to-hash describing the order. The keys of
1201 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1206 my ($ordernumber) = @_;
1207 return unless $ordernumber;
1209 my $dbh = C4
::Context
->dbh;
1210 my $query = qq{SELECT
1214 aqbasket
.basketname
,
1215 borrowers
.branchcode
,
1216 biblioitems
.publicationyear
,
1217 biblio
.copyrightdate
,
1218 biblioitems
.editionstatement
,
1222 biblioitems
.publishercode
,
1223 aqorders
.rrp AS unitpricesupplier
,
1224 aqorders
.ecost AS unitpricelib
,
1225 aqbudgets
.budget_name AS budget
,
1226 aqbooksellers
.name AS supplier
,
1227 aqbooksellers
.id AS supplierid
,
1228 biblioitems
.publishercode AS publisher
,
1229 ADDDATE
(aqbasket
.closedate
, INTERVAL aqbooksellers
.deliverytime DAY
) AS estimateddeliverydate
,
1230 DATE
(aqbasket
.closedate
) AS orderdate
,
1231 aqorders
.quantity
- COALESCE
(aqorders
.quantityreceived
,0) AS quantity_to_receive
,
1232 (aqorders
.quantity
- COALESCE
(aqorders
.quantityreceived
,0)) * aqorders
.rrp AS subtotal
,
1233 DATEDIFF
(CURDATE
( ),closedate
) AS latesince
1234 FROM aqorders LEFT JOIN biblio ON biblio
.biblionumber
= aqorders
.biblionumber
1235 LEFT JOIN biblioitems ON biblioitems
.biblionumber
= biblio
.biblionumber
1236 LEFT JOIN aqbudgets ON aqorders
.budget_id
= aqbudgets
.budget_id
,
1237 aqbasket LEFT JOIN borrowers ON aqbasket
.authorisedby
= borrowers
.borrowernumber
1238 LEFT JOIN aqbooksellers ON aqbasket
.booksellerid
= aqbooksellers
.id
1239 WHERE aqorders
.basketno
= aqbasket
.basketno
1242 $dbh->selectall_arrayref( $query, { Slice
=> {} }, $ordernumber );
1244 # result_set assumed to contain 1 match
1245 return $result_set->[0];
1250 &ModOrder(\%hashref);
1252 Modifies an existing order. Updates the order with order number
1253 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1254 other keys of the hash update the fields with the same name in the aqorders
1255 table of the Koha database.
1260 my $orderinfo = shift;
1262 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '';
1264 my $dbh = C4
::Context
->dbh;
1267 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1268 $orderinfo->{uncertainprice
}=1 if $orderinfo->{uncertainprice
};
1270 # delete($orderinfo->{'branchcode'});
1271 # the hash contains a lot of entries not in aqorders, so get the columns ...
1272 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1274 my $colnames = $sth->{NAME
};
1275 #FIXME Be careful. If aqorders would have columns with diacritics,
1276 #you should need to decode what you get back from NAME.
1277 #See report 10110 and guided_reports.pl
1278 my $query = "UPDATE aqorders SET ";
1280 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1281 # ... and skip hash entries that are not in the aqorders table
1282 # FIXME : probably not the best way to do it (would be better to have a correct hash)
1283 next unless grep { $_ eq $orderinfokey } @
$colnames;
1284 $query .= "$orderinfokey=?, ";
1285 push(@params, $orderinfo->{$orderinfokey});
1288 $query .= "timestamp=NOW() WHERE ordernumber=?";
1289 push(@params, $orderinfo->{'ordernumber'} );
1290 $sth = $dbh->prepare($query);
1291 $sth->execute(@params);
1295 #------------------------------------------------------------#
1299 ModItemOrder($itemnumber, $ordernumber);
1301 Modifies the ordernumber of an item in aqorders_items.
1306 my ($itemnumber, $ordernumber) = @_;
1308 return unless ($itemnumber and $ordernumber);
1310 my $dbh = C4
::Context
->dbh;
1312 UPDATE aqorders_items
1314 WHERE itemnumber
= ?
1316 my $sth = $dbh->prepare($query);
1317 return $sth->execute($ordernumber, $itemnumber);
1320 #------------------------------------------------------------#
1322 =head3 ModReceiveOrder
1324 my ( $date_received, $new_ordernumber ) = ModReceiveOrder(
1326 biblionumber => $biblionumber,
1328 quantityreceived => $quantityreceived,
1330 invoice => $invoice,
1331 budget_id => $budget_id,
1332 datereceived => $datereceived,
1333 received_itemnumbers => \@received_itemnumbers,
1337 Updates an order, to reflect the fact that it was received, at least
1340 If a partial order is received, splits the order into two.
1342 Updates the order with biblionumber C<$biblionumber> and ordernumber
1343 C<$order->{ordernumber}>.
1348 sub ModReceiveOrder
{
1350 my $biblionumber = $params->{biblionumber
};
1351 my $order = { %{ $params->{order
} } }; # Copy the order, we don't want to modify it
1352 my $invoice = $params->{invoice
};
1353 my $quantrec = $params->{quantityreceived
};
1354 my $user = $params->{user
};
1355 my $budget_id = $params->{budget_id
};
1356 my $datereceived = $params->{datereceived
};
1357 my $received_items = $params->{received_items
};
1359 my $dbh = C4
::Context
->dbh;
1360 $datereceived = output_pref
(
1362 dt
=> ( $datereceived ? dt_from_string
( $datereceived ) : dt_from_string
),
1363 dateformat
=> 'iso',
1368 my $suggestionid = GetSuggestionFromBiblionumber
( $biblionumber );
1369 if ($suggestionid) {
1370 ModSuggestion
( {suggestionid
=>$suggestionid,
1371 STATUS
=>'AVAILABLE',
1372 biblionumber
=> $biblionumber}
1376 my $result_set = $dbh->selectrow_arrayref(
1377 q{SELECT aqbasket.is_standing
1379 WHERE basketno=?},{ Slice
=> {} }, $order->{basketno
});
1380 my $is_standing = $result_set->[0]; # we assume we have a unique basket
1382 my $new_ordernumber = $order->{ordernumber
};
1383 if ( $is_standing || $order->{quantity
} > $quantrec ) {
1384 # Split order line in two parts: the first is the original order line
1385 # without received items (the quantity is decreased),
1386 # the second part is a new order line with quantity=quantityrec
1387 # (entirely received)
1391 orderstatus
= 'partial'|;
1392 $query .= q
| WHERE ordernumber
= ?
|;
1393 my $sth = $dbh->prepare($query);
1396 ( $is_standing ?
1 : ($order->{quantity
} - $quantrec) ),
1397 $order->{ordernumber
}
1400 if ( not $order->{subscriptionid
} && defined $order->{order_internalnote
} ) {
1403 SET order_internalnote
= ?
1404 WHERE ordernumber
= ?
|, {},
1405 $order->{order_internalnote
}, $order->{ordernumber
}
1409 # Recalculate tax_value
1413 tax_value_on_ordering
= quantity
* | . get_rounding_sql
(q
|ecost_tax_excluded
|) . q
| * tax_rate_on_ordering
,
1414 tax_value_on_receiving
= quantity
* | . get_rounding_sql
(q
|unitprice_tax_excluded
|) . q
| * tax_rate_on_receiving
1415 WHERE ordernumber
= ?
1416 |, undef, $order->{ordernumber
});
1418 delete $order->{ordernumber
};
1419 $order->{budget_id
} = ( $budget_id || $order->{budget_id
} );
1420 $order->{quantity
} = $quantrec;
1421 $order->{quantityreceived
} = $quantrec;
1422 $order->{ecost_tax_excluded
} //= 0;
1423 $order->{tax_rate_on_ordering
} //= 0;
1424 $order->{unitprice_tax_excluded
} //= 0;
1425 $order->{tax_rate_on_receiving
} //= 0;
1426 $order->{tax_value_on_ordering
} = $order->{quantity
} * get_rounded_price
($order->{ecost_tax_excluded
}) * $order->{tax_rate_on_ordering
};
1427 $order->{tax_value_on_receiving
} = $order->{quantity
} * get_rounded_price
($order->{unitprice_tax_excluded
}) * $order->{tax_rate_on_receiving
};
1428 $order->{datereceived
} = $datereceived;
1429 $order->{invoiceid
} = $invoice->{invoiceid
};
1430 $order->{orderstatus
} = 'complete';
1431 $new_ordernumber = Koha
::Acquisition
::Order
->new($order)->store->ordernumber; # TODO What if the store fails?
1433 if ($received_items) {
1434 foreach my $itemnumber (@
$received_items) {
1435 ModItemOrder
($itemnumber, $new_ordernumber);
1441 SET quantityreceived
= ?
,
1445 orderstatus
= 'complete'
1449 , replacementprice
= ?
1450 | if defined $order->{replacementprice
};
1453 , unitprice
= ?
, unitprice_tax_included
= ?
, unitprice_tax_excluded
= ?
1454 | if defined $order->{unitprice
};
1457 ,tax_value_on_receiving
= ?
1458 | if defined $order->{tax_value_on_receiving
};
1461 ,tax_rate_on_receiving
= ?
1462 | if defined $order->{tax_rate_on_receiving
};
1465 , order_internalnote
= ?
1466 | if defined $order->{order_internalnote
};
1468 $query .= q
| where biblionumber
=?
and ordernumber
=?
|;
1470 my $sth = $dbh->prepare( $query );
1471 my @params = ( $quantrec, $datereceived, $invoice->{invoiceid
}, ( $budget_id ?
$budget_id : $order->{budget_id
} ) );
1473 if ( defined $order->{replacementprice
} ) {
1474 push @params, $order->{replacementprice
};
1477 if ( defined $order->{unitprice
} ) {
1478 push @params, $order->{unitprice
}, $order->{unitprice_tax_included
}, $order->{unitprice_tax_excluded
};
1481 if ( defined $order->{tax_value_on_receiving
} ) {
1482 push @params, $order->{tax_value_on_receiving
};
1485 if ( defined $order->{tax_rate_on_receiving
} ) {
1486 push @params, $order->{tax_rate_on_receiving
};
1489 if ( defined $order->{order_internalnote
} ) {
1490 push @params, $order->{order_internalnote
};
1493 push @params, ( $biblionumber, $order->{ordernumber
} );
1495 $sth->execute( @params );
1497 # All items have been received, sent a notification to users
1498 NotifyOrderUsers
( $order->{ordernumber
} );
1501 return ($datereceived, $new_ordernumber);
1504 =head3 CancelReceipt
1506 my $parent_ordernumber = CancelReceipt($ordernumber);
1508 Cancel an order line receipt and update the parent order line, as if no
1510 If items are created at receipt (AcqCreateItem = receiving) then delete
1516 my $ordernumber = shift;
1518 return unless $ordernumber;
1520 my $dbh = C4
::Context
->dbh;
1522 SELECT datereceived
, parent_ordernumber
, quantity
1524 WHERE ordernumber
= ?
1526 my $sth = $dbh->prepare($query);
1527 $sth->execute($ordernumber);
1528 my $order = $sth->fetchrow_hashref;
1530 warn "CancelReceipt: order $ordernumber does not exist";
1533 unless($order->{'datereceived'}) {
1534 warn "CancelReceipt: order $ordernumber is not received";
1538 my $parent_ordernumber = $order->{'parent_ordernumber'};
1540 my $order_obj = Koha
::Acquisition
::Orders
->find( $ordernumber ); # FIXME rewrite all this subroutine using this object
1541 my @itemnumbers = $order_obj->items->get_column('itemnumber');
1543 if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1544 # The order line has no parent, just mark it as not received
1547 SET quantityreceived
= ?
,
1550 orderstatus
= 'ordered'
1551 WHERE ordernumber
= ?
1553 $sth = $dbh->prepare($query);
1554 $sth->execute(0, undef, undef, $ordernumber);
1555 _cancel_items_receipt
( $order_obj );
1557 # The order line has a parent, increase parent quantity and delete
1559 unless ( $order_obj->basket->is_standing ) {
1561 SELECT quantity
, datereceived
1563 WHERE ordernumber
= ?
1565 $sth = $dbh->prepare($query);
1566 $sth->execute($parent_ordernumber);
1567 my $parent_order = $sth->fetchrow_hashref;
1568 unless($parent_order) {
1569 warn "Parent order $parent_ordernumber does not exist.";
1572 if($parent_order->{'datereceived'}) {
1573 warn "CancelReceipt: parent order is received.".
1574 " Can't cancel receipt.";
1580 orderstatus
= 'ordered'
1581 WHERE ordernumber
= ?
1583 $sth = $dbh->prepare($query);
1584 my $rv = $sth->execute(
1585 $order->{'quantity'} + $parent_order->{'quantity'},
1589 warn "Cannot update parent order line, so do not cancel".
1594 # Recalculate tax_value
1598 tax_value_on_ordering
= quantity
* | . get_rounding_sql
(q
|ecost_tax_excluded
|) . q
| * tax_rate_on_ordering
,
1599 tax_value_on_receiving
= quantity
* | . get_rounding_sql
(q
|unitprice_tax_excluded
|) . q
| * tax_rate_on_receiving
1600 WHERE ordernumber
= ?
1601 |, undef, $parent_ordernumber);
1604 _cancel_items_receipt
( $order_obj, $parent_ordernumber );
1607 DELETE FROM aqorders
1608 WHERE ordernumber
= ?
1610 $sth = $dbh->prepare($query);
1611 $sth->execute($ordernumber);
1615 if( $order_obj->basket->effective_create_items eq 'ordering' ) {
1616 my @affects = split q{\|}, C4
::Context
->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1618 for my $in ( @itemnumbers ) {
1619 my $item = Koha
::Items
->find( $in ); # FIXME We do not need that, we already have Koha::Items from $order_obj->items
1620 my $biblio = $item->biblio;
1621 my ( $itemfield ) = GetMarcFromKohaField
( 'items.itemnumber' );
1622 my $item_marc = C4
::Items
::GetMarcItem
( $biblio->biblionumber, $in );
1623 for my $affect ( @affects ) {
1624 my ( $sf, $v ) = split q{=}, $affect, 2;
1625 foreach ( $item_marc->field($itemfield) ) {
1626 $_->update( $sf => $v );
1629 C4
::Items
::ModItemFromMarc
( $item_marc, $biblio->biblionumber, $in );
1634 return $parent_ordernumber;
1637 sub _cancel_items_receipt
{
1638 my ( $order, $parent_ordernumber ) = @_;
1639 $parent_ordernumber ||= $order->ordernumber;
1641 my $items = $order->items;
1642 if ( $order->basket->effective_create_items eq 'receiving' ) {
1643 # Remove items that were created at receipt
1645 DELETE FROM items
, aqorders_items
1646 USING items
, aqorders_items
1647 WHERE items
.itemnumber
= ? AND aqorders_items
.itemnumber
= ?
1649 my $dbh = C4
::Context
->dbh;
1650 my $sth = $dbh->prepare($query);
1651 while ( my $item = $items->next ) {
1652 $sth->execute($item->itemnumber, $item->itemnumber);
1656 while ( my $item = $items->next ) {
1657 ModItemOrder
($item->itemnumber, $parent_ordernumber);
1662 #------------------------------------------------------------#
1666 @results = &SearchOrders({
1667 ordernumber => $ordernumber,
1670 booksellerid => $booksellerid,
1671 basketno => $basketno,
1672 basketname => $basketname,
1673 basketgroupname => $basketgroupname,
1677 biblionumber => $biblionumber,
1678 budget_id => $budget_id
1681 Searches for orders filtered by criteria.
1683 C<$ordernumber> Finds matching orders or transferred orders by ordernumber.
1684 C<$search> Finds orders matching %$search% in title, author, or isbn.
1685 C<$owner> Finds order for the logged in user.
1686 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1687 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1690 C<@results> is an array of references-to-hash with the keys are fields
1691 from aqorders, biblio, biblioitems and aqbasket tables.
1696 my ( $params ) = @_;
1697 my $ordernumber = $params->{ordernumber
};
1698 my $search = $params->{search
};
1699 my $ean = $params->{ean
};
1700 my $booksellerid = $params->{booksellerid
};
1701 my $basketno = $params->{basketno
};
1702 my $basketname = $params->{basketname
};
1703 my $basketgroupname = $params->{basketgroupname
};
1704 my $owner = $params->{owner
};
1705 my $pending = $params->{pending
};
1706 my $ordered = $params->{ordered
};
1707 my $biblionumber = $params->{biblionumber
};
1708 my $budget_id = $params->{budget_id
};
1710 my $dbh = C4
::Context
->dbh;
1713 SELECT aqbasket.basketno,
1715 borrowers.firstname,
1718 biblioitems.biblioitemnumber,
1719 biblioitems.publishercode,
1720 biblioitems.publicationyear,
1721 aqbasket.authorisedby,
1722 aqbasket.booksellerid,
1724 aqbasket.creationdate,
1725 aqbasket.basketname,
1726 aqbasketgroups.id as basketgroupid,
1727 aqbasketgroups.name as basketgroupname,
1730 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1731 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1732 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1733 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1734 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1737 # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
1739 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1743 WHERE (datecancellationprinted is NULL)
1746 if ( $pending or $ordered ) {
1749 ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) )
1751 ( quantity > quantityreceived OR quantityreceived is NULL )
1755 $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1763 my $userenv = C4
::Context
->userenv;
1764 if ( C4
::Context
->preference("IndependentBranches") ) {
1765 unless ( C4
::Context
->IsSuperLibrarian() ) {
1768 borrowers.branchcode = ?
1769 OR borrowers.branchcode = ''
1772 push @args, $userenv->{branch
};
1776 if ( $ordernumber ) {
1777 $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1778 push @args, ( $ordernumber, $ordernumber );
1780 if ( $biblionumber ) {
1781 $query .= 'AND aqorders.biblionumber = ?';
1782 push @args, $biblionumber;
1785 $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1786 push @args, ("%$search%","%$search%","%$search%");
1789 $query .= ' AND biblioitems.ean = ?';
1792 if ( $booksellerid ) {
1793 $query .= 'AND aqbasket.booksellerid = ?';
1794 push @args, $booksellerid;
1797 $query .= 'AND aqbasket.basketno = ?';
1798 push @args, $basketno;
1801 $query .= 'AND aqbasket.basketname LIKE ?';
1802 push @args, "%$basketname%";
1804 if( $basketgroupname ) {
1805 $query .= ' AND aqbasketgroups.name LIKE ?';
1806 push @args, "%$basketgroupname%";
1810 $query .= ' AND aqbasket.authorisedby=? ';
1811 push @args, $userenv->{'number'};
1815 $query .= ' AND aqorders.budget_id = ?';
1816 push @args, $budget_id;
1819 $query .= ' ORDER BY aqbasket.basketno';
1821 my $sth = $dbh->prepare($query);
1822 $sth->execute(@args);
1823 return $sth->fetchall_arrayref({});
1826 #------------------------------------------------------------#
1830 &DelOrder($biblionumber, $ordernumber);
1832 Cancel the order with the given order and biblio numbers. It does not
1833 delete any entries in the aqorders table, it merely marks them as
1839 my ( $bibnum, $ordernumber, $delete_biblio, $reason ) = @_;
1841 my $dbh = C4
::Context
->dbh;
1844 SET datecancellationprinted=now(), orderstatus='cancelled'
1847 $query .= ", cancellationreason = ? ";
1850 WHERE biblionumber=? AND ordernumber=?
1852 my $sth = $dbh->prepare($query);
1854 $sth->execute($reason, $bibnum, $ordernumber);
1856 $sth->execute( $bibnum, $ordernumber );
1860 my $order = Koha
::Acquisition
::Orders
->find($ordernumber);
1861 my $items = $order->items;
1862 while ( my $item = $items->next ) { # Should be moved to Koha::Acquisition::Order->delete
1863 my $delcheck = $item->safe_delete;
1865 if($delcheck ne '1') {
1866 $error->{'delitem'} = 1;
1870 if($delete_biblio) {
1871 # We get the number of remaining items
1872 my $biblio = Koha
::Biblios
->find( $bibnum );
1873 my $itemcount = $biblio->items->count;
1875 # If there are no items left,
1876 if ( $itemcount == 0 ) {
1877 # We delete the record
1878 my $delcheck = DelBiblio
($bibnum);
1881 $error->{'delbiblio'} = 1;
1889 =head3 TransferOrder
1891 my $newordernumber = TransferOrder($ordernumber, $basketno);
1893 Transfer an order line to a basket.
1894 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1895 to BOOKSELLER on DATE' and create new order with internal note
1896 'Transferred from BOOKSELLER on DATE'.
1897 Move all attached items to the new order.
1898 Received orders cannot be transferred.
1899 Return the ordernumber of created order.
1904 my ($ordernumber, $basketno) = @_;
1906 return unless ($ordernumber and $basketno);
1908 my $order = Koha
::Acquisition
::Orders
->find( $ordernumber ) or return;
1909 return if $order->datereceived;
1911 $order = $order->unblessed;
1913 my $basket = GetBasket
($basketno);
1914 return unless $basket;
1916 my $dbh = C4
::Context
->dbh;
1917 my ($query, $sth, $rv);
1921 SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1922 WHERE ordernumber = ?
1924 $sth = $dbh->prepare($query);
1925 $rv = $sth->execute('cancelled', $ordernumber);
1927 delete $order->{'ordernumber'};
1928 delete $order->{parent_ordernumber
};
1929 $order->{'basketno'} = $basketno;
1931 my $newordernumber = Koha
::Acquisition
::Order
->new($order)->store->ordernumber;
1934 UPDATE aqorders_items
1936 WHERE ordernumber = ?
1938 $sth = $dbh->prepare($query);
1939 $sth->execute($newordernumber, $ordernumber);
1942 INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1945 $sth = $dbh->prepare($query);
1946 $sth->execute($ordernumber, $newordernumber);
1948 return $newordernumber;
1951 =head3 get_rounding_sql
1953 $rounding_sql = get_rounding_sql($column_name);
1955 returns the correct SQL routine based on OrderPriceRounding system preference.
1959 sub get_rounding_sql
{
1960 my ( $round_string ) = @_;
1961 my $rounding_pref = C4
::Context
->preference('OrderPriceRounding') // q{};
1962 if ( $rounding_pref eq "nearest_cent" ) {
1963 return "CAST($round_string*100 AS SIGNED)/100";
1965 return $round_string;
1968 =head3 get_rounded_price
1970 $rounded_price = get_rounded_price( $price );
1972 returns a price rounded as specified in OrderPriceRounding system preference.
1976 sub get_rounded_price
{
1978 my $rounding_pref = C4
::Context
->preference('OrderPriceRounding') // q{};
1979 if( $rounding_pref eq 'nearest_cent' ) {
1980 return Koha
::Number
::Price
->new( $price )->round();
1986 =head2 FUNCTIONS ABOUT PARCELS
1990 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1992 get a lists of parcels.
1999 is the bookseller this function has to get parcels.
2002 To know on what criteria the results list has to be ordered.
2005 is the booksellerinvoicenumber.
2007 =item $datefrom & $dateto
2008 to know on what date this function has to filter its search.
2013 a pointer on a hash list containing parcel informations as such :
2019 =item Last operation
2021 =item Number of biblio
2023 =item Number of items
2030 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
2031 my $dbh = C4
::Context
->dbh;
2032 my @query_params = ();
2034 SELECT aqinvoices.invoicenumber,
2035 datereceived,purchaseordernumber,
2036 count(DISTINCT biblionumber) AS biblio,
2037 sum(quantity) AS itemsexpected,
2038 sum(quantityreceived) AS itemsreceived
2039 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
2040 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2041 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
2043 push @query_params, $bookseller;
2045 if ( defined $code ) {
2046 $strsth .= ' and aqinvoices.invoicenumber like ? ';
2047 # add a % to the end of the code to allow stemming.
2048 push @query_params, "$code%";
2051 if ( defined $datefrom ) {
2052 $strsth .= ' and datereceived >= ? ';
2053 push @query_params, $datefrom;
2056 if ( defined $dateto ) {
2057 $strsth .= 'and datereceived <= ? ';
2058 push @query_params, $dateto;
2061 $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
2063 # can't use a placeholder to place this column name.
2064 # but, we could probably be checking to make sure it is a column that will be fetched.
2065 $strsth .= "order by $order " if ($order);
2067 my $sth = $dbh->prepare($strsth);
2069 $sth->execute( @query_params );
2070 my $results = $sth->fetchall_arrayref({});
2074 #------------------------------------------------------------#
2078 \@order_loop = GetHistory( %params );
2080 Retreives some acquisition history information
2090 basket - search both basket name and number
2091 booksellerinvoicenumber
2094 orderstatus (note that orderstatus '' will retrieve orders
2095 of any status except cancelled)
2099 get_canceled_order (if set to a true value, cancelled orders will
2103 $order_loop is a list of hashrefs that each look like this:
2105 'author' => 'Twain, Mark',
2107 'biblionumber' => '215',
2109 'creationdate' => 'MM/DD/YYYY',
2110 'datereceived' => undef,
2113 'invoicenumber' => undef,
2115 'ordernumber' => '1',
2117 'quantityreceived' => undef,
2118 'title' => 'The Adventures of Huckleberry Finn',
2119 'managing_library' => 'CPL'
2120 'is_standing' => '1'
2126 # don't run the query if there are no parameters (list would be too long for sure !)
2127 croak
"No search params" unless @_;
2129 my $title = $params{title
};
2130 my $author = $params{author
};
2131 my $isbn = $params{isbn
};
2132 my $ean = $params{ean
};
2133 my $name = $params{name
};
2134 my $from_placed_on = $params{from_placed_on
};
2135 my $to_placed_on = $params{to_placed_on
};
2136 my $basket = $params{basket
};
2137 my $booksellerinvoicenumber = $params{booksellerinvoicenumber
};
2138 my $basketgroupname = $params{basketgroupname
};
2139 my $budget = $params{budget
};
2140 my $orderstatus = $params{orderstatus
};
2141 my $is_standing = $params{is_standing
};
2142 my $biblionumber = $params{biblionumber
};
2143 my $get_canceled_order = $params{get_canceled_order
} || 0;
2144 my $ordernumber = $params{ordernumber
};
2145 my $search_children_too = $params{search_children_too
} || 0;
2146 my $created_by = $params{created_by
} || [];
2147 my $managing_library = $params{managing_library
};
2148 my $ordernumbers = $params{ordernumbers
} || [];
2149 my $additional_fields = $params{additional_fields
} // [];
2152 my $total_qtyreceived = 0;
2153 my $total_price = 0;
2155 #get variation of isbn
2159 if ( C4
::Context
->preference("SearchWithISBNVariations") ){
2160 @isbns = C4
::Koha
::GetVariationsOfISBN
( $isbn );
2161 foreach my $isb (@isbns){
2162 push @isbn_params, '?';
2167 push @isbn_params, '?';
2171 my $dbh = C4
::Context
->dbh;
2174 COALESCE(biblio.title, deletedbiblio.title) AS title,
2175 COALESCE(biblio.author, deletedbiblio.author) AS author,
2176 COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2177 COALESCE(biblioitems.ean, deletedbiblioitems.ean) AS ean,
2179 aqbasket.basketname,
2180 aqbasket.basketgroupid,
2181 aqbasket.authorisedby,
2182 aqbasket.is_standing,
2183 concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2184 branch as managing_library,
2185 aqbasketgroups.name as groupname,
2187 aqbasket.creationdate,
2188 aqorders.datereceived,
2190 aqorders.quantityreceived,
2192 aqorders.ordernumber,
2194 aqinvoices.invoicenumber,
2195 aqbooksellers.id as id,
2196 aqorders.biblionumber,
2197 aqorders.orderstatus,
2198 aqorders.parent_ordernumber,
2199 aqbudgets.budget_name
2201 $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2204 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2205 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2206 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2207 LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2208 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2209 LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2210 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2211 LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2212 LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2213 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2216 $query .= " WHERE 1 ";
2218 unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2219 $query .= " AND datecancellationprinted IS NULL ";
2222 my @query_params = ();
2224 if ( $biblionumber ) {
2225 $query .= " AND biblio.biblionumber = ?";
2226 push @query_params, $biblionumber;
2230 $query .= " AND biblio.title LIKE ? ";
2231 $title =~ s/\s+/%/g;
2232 push @query_params, "%$title%";
2236 $query .= " AND biblio.author LIKE ? ";
2237 push @query_params, "%$author%";
2241 $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2242 foreach my $isb (@isbns){
2243 push @query_params, "%$isb%";
2248 $query .= " AND biblioitems.ean = ? ";
2249 push @query_params, "$ean";
2252 $query .= " AND aqbooksellers.name LIKE ? ";
2253 push @query_params, "%$name%";
2257 $query .= " AND aqbudgets.budget_id = ? ";
2258 push @query_params, "$budget";
2261 if ( $from_placed_on ) {
2262 $query .= " AND creationdate >= ? ";
2263 push @query_params, $from_placed_on;
2266 if ( $to_placed_on ) {
2267 $query .= " AND creationdate <= ? ";
2268 push @query_params, $to_placed_on;
2271 if ( defined $orderstatus and $orderstatus ne '') {
2272 $query .= " AND aqorders.orderstatus = ? ";
2273 push @query_params, "$orderstatus";
2276 if ( $is_standing ) {
2277 $query .= " AND is_standing = ? ";
2278 push @query_params, $is_standing;
2282 if ($basket =~ m/^\d+$/) {
2283 $query .= " AND aqorders.basketno = ? ";
2284 push @query_params, $basket;
2286 $query .= " AND aqbasket.basketname LIKE ? ";
2287 push @query_params, "%$basket%";
2291 if ($booksellerinvoicenumber) {
2292 $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2293 push @query_params, "%$booksellerinvoicenumber%";
2296 if ($basketgroupname) {
2297 $query .= " AND aqbasketgroups.name LIKE ? ";
2298 push @query_params, "%$basketgroupname%";
2302 $query .= " AND (aqorders.ordernumber = ? ";
2303 push @query_params, $ordernumber;
2304 if ($search_children_too) {
2305 $query .= " OR aqorders.parent_ordernumber = ? ";
2306 push @query_params, $ordernumber;
2311 if ( @
$created_by ) {
2312 $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @
$created_by ) . ')';
2313 push @query_params, @
$created_by;
2316 if ( $managing_library ) {
2317 $query .= " AND aqbasket.branch = ? ";
2318 push @query_params, $managing_library;
2321 if ( @
$ordernumbers ) {
2322 $query .= ' AND (aqorders.ordernumber IN ( ' . join (',', ('?') x @
$ordernumbers ) . '))';
2323 push @query_params, @
$ordernumbers;
2325 if ( @
$additional_fields ) {
2326 my @baskets = Koha
::Acquisition
::Baskets
->filter_by_additional_fields($additional_fields);
2328 return [] unless @baskets;
2330 # No parameterization because record IDs come directly from DB
2331 $query .= ' AND aqbasket.basketno IN ( ' . join( ',', map { $_->basketno } @baskets ) . ' )';
2334 if ( C4
::Context
->preference("IndependentBranches") ) {
2335 unless ( C4
::Context
->IsSuperLibrarian() ) {
2336 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2337 push @query_params, C4
::Context
->userenv->{branch
};
2340 $query .= " ORDER BY id";
2342 return $dbh->selectall_arrayref( $query, { Slice
=> {} }, @query_params );
2345 =head2 GetRecentAcqui
2347 $results = GetRecentAcqui($days);
2349 C<$results> is a ref to a table which contains hashref
2353 sub GetRecentAcqui
{
2355 my $dbh = C4
::Context
->dbh;
2359 ORDER BY timestamp DESC
2362 my $sth = $dbh->prepare($query);
2364 my $results = $sth->fetchall_arrayref({});
2368 #------------------------------------------------------------#
2372 &AddClaim($ordernumber);
2374 Add a claim for an order
2379 my ($ordernumber) = @_;
2380 my $dbh = C4
::Context
->dbh;
2383 claims_count = claims_count + 1,
2384 claimed_date = CURDATE()
2385 WHERE ordernumber = ?
2387 my $sth = $dbh->prepare($query);
2388 $sth->execute($ordernumber);
2393 my @invoices = GetInvoices(
2394 invoicenumber => $invoicenumber,
2395 supplierid => $supplierid,
2396 suppliername => $suppliername,
2397 shipmentdatefrom => $shipmentdatefrom, # ISO format
2398 shipmentdateto => $shipmentdateto, # ISO format
2399 billingdatefrom => $billingdatefrom, # ISO format
2400 billingdateto => $billingdateto, # ISO format
2401 isbneanissn => $isbn_or_ean_or_issn,
2404 publisher => $publisher,
2405 publicationyear => $publicationyear,
2406 branchcode => $branchcode,
2407 order_by => $order_by
2410 Return a list of invoices that match all given criteria.
2412 $order_by is "column_name (asc|desc)", where column_name is any of
2413 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2414 'shipmentcost', 'shipmentcost_budgetid'.
2416 asc is the default if omitted
2423 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2424 closedate shipmentcost shipmentcost_budgetid);
2426 my $dbh = C4
::Context
->dbh;
2428 SELECT aqinvoices
.invoiceid
, aqinvoices
.invoicenumber
, aqinvoices
.booksellerid
, aqinvoices
.shipmentdate
, aqinvoices
.billingdate
, aqinvoices
.closedate
, aqinvoices
.shipmentcost
, aqinvoices
.shipmentcost_budgetid
, aqinvoices
.message_id
,
2429 aqbooksellers
.name AS suppliername
,
2432 aqorders
.datereceived IS NOT NULL
,
2433 aqorders
.biblionumber
,
2436 ) AS receivedbiblios
,
2439 aqorders
.subscriptionid IS NOT NULL
,
2440 aqorders
.subscriptionid
,
2443 ) AS is_linked_to_subscriptions
,
2444 SUM
(aqorders
.quantityreceived
) AS receiveditems
2446 LEFT JOIN aqbooksellers ON aqbooksellers
.id
= aqinvoices
.booksellerid
2447 LEFT JOIN aqorders ON aqorders
.invoiceid
= aqinvoices
.invoiceid
2448 LEFT JOIN aqbasket ON aqbasket
.basketno
=aqorders
.basketno
2449 LEFT JOIN borrowers ON aqbasket
.authorisedby
=borrowers
.borrowernumber
2450 LEFT JOIN biblio ON aqorders
.biblionumber
= biblio
.biblionumber
2451 LEFT JOIN biblioitems ON biblio
.biblionumber
= biblioitems
.biblionumber
2452 LEFT JOIN subscription ON biblio
.biblionumber
= subscription
.biblionumber
2457 if($args{supplierid
}) {
2458 push @bind_strs, " aqinvoices.booksellerid = ? ";
2459 push @bind_args, $args{supplierid
};
2461 if($args{invoicenumber
}) {
2462 push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2463 push @bind_args, "%$args{invoicenumber}%";
2465 if($args{suppliername
}) {
2466 push @bind_strs, " aqbooksellers.name LIKE ? ";
2467 push @bind_args, "%$args{suppliername}%";
2469 if($args{shipmentdatefrom
}) {
2470 push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2471 push @bind_args, $args{shipmentdatefrom
};
2473 if($args{shipmentdateto
}) {
2474 push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2475 push @bind_args, $args{shipmentdateto
};
2477 if($args{billingdatefrom
}) {
2478 push @bind_strs, " aqinvoices.billingdate >= ? ";
2479 push @bind_args, $args{billingdatefrom
};
2481 if($args{billingdateto
}) {
2482 push @bind_strs, " aqinvoices.billingdate <= ? ";
2483 push @bind_args, $args{billingdateto
};
2485 if($args{isbneanissn
}) {
2486 push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2487 push @bind_args, $args{isbneanissn
}, $args{isbneanissn
}, $args{isbneanissn
};
2490 push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2491 push @bind_args, $args{title
};
2494 push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2495 push @bind_args, $args{author
};
2497 if($args{publisher
}) {
2498 push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2499 push @bind_args, $args{publisher
};
2501 if($args{publicationyear
}) {
2502 push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2503 push @bind_args, $args{publicationyear
}, $args{publicationyear
};
2505 if($args{branchcode
}) {
2506 push @bind_strs, " borrowers.branchcode = ? ";
2507 push @bind_args, $args{branchcode
};
2509 if($args{message_id
}) {
2510 push @bind_strs, " aqinvoices.message_id = ? ";
2511 push @bind_args, $args{message_id
};
2514 $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2515 $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";
2517 if($args{order_by
}) {
2518 my ($column, $direction) = split / /, $args{order_by
};
2519 if(grep { $_ eq $column } @columns) {
2520 $direction ||= 'ASC';
2521 $query .= " ORDER BY $column $direction";
2525 my $sth = $dbh->prepare($query);
2526 $sth->execute(@bind_args);
2528 my $results = $sth->fetchall_arrayref({});
2534 my $invoice = GetInvoice($invoiceid);
2536 Get informations about invoice with given $invoiceid
2538 Return a hash filled with aqinvoices.* fields
2543 my ($invoiceid) = @_;
2546 return unless $invoiceid;
2548 my $dbh = C4
::Context
->dbh;
2554 my $sth = $dbh->prepare($query);
2555 $sth->execute($invoiceid);
2557 $invoice = $sth->fetchrow_hashref;
2561 =head3 GetInvoiceDetails
2563 my $invoice = GetInvoiceDetails($invoiceid)
2565 Return informations about an invoice + the list of related order lines
2567 Orders informations are in $invoice->{orders} (array ref)
2571 sub GetInvoiceDetails
{
2572 my ($invoiceid) = @_;
2574 if ( !defined $invoiceid ) {
2575 carp
'GetInvoiceDetails called without an invoiceid';
2579 my $dbh = C4
::Context
->dbh;
2581 SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2583 LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2586 my $sth = $dbh->prepare($query);
2587 $sth->execute($invoiceid);
2589 my $invoice = $sth->fetchrow_hashref;
2594 biblio.copyrightdate,
2596 biblioitems.publishercode,
2597 biblioitems.publicationyear,
2598 aqbasket.basketname,
2599 aqbasketgroups.id AS basketgroupid,
2600 aqbasketgroups.name AS basketgroupname
2602 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2603 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2604 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2605 LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2608 $sth = $dbh->prepare($query);
2609 $sth->execute($invoiceid);
2610 $invoice->{orders
} = $sth->fetchall_arrayref({});
2611 $invoice->{orders
} ||= []; # force an empty arrayref if fetchall_arrayref fails
2618 my $invoiceid = AddInvoice(
2619 invoicenumber => $invoicenumber,
2620 booksellerid => $booksellerid,
2621 shipmentdate => $shipmentdate,
2622 billingdate => $billingdate,
2623 closedate => $closedate,
2624 shipmentcost => $shipmentcost,
2625 shipmentcost_budgetid => $shipmentcost_budgetid
2628 Create a new invoice and return its id or undef if it fails.
2635 return unless(%invoice and $invoice{invoicenumber
});
2637 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2638 closedate shipmentcost shipmentcost_budgetid message_id);
2642 foreach my $key (keys %invoice) {
2643 if(0 < grep { $_ eq $key } @columns) {
2644 push @set_strs, "$key = ?";
2645 push @set_args, ($invoice{$key} || undef);
2651 my $dbh = C4
::Context
->dbh;
2652 my $query = "INSERT INTO aqinvoices SET ";
2653 $query .= join (",", @set_strs);
2654 my $sth = $dbh->prepare($query);
2655 $rv = $sth->execute(@set_args);
2657 $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2666 invoiceid => $invoiceid, # Mandatory
2667 invoicenumber => $invoicenumber,
2668 booksellerid => $booksellerid,
2669 shipmentdate => $shipmentdate,
2670 billingdate => $billingdate,
2671 closedate => $closedate,
2672 shipmentcost => $shipmentcost,
2673 shipmentcost_budgetid => $shipmentcost_budgetid
2676 Modify an invoice, invoiceid is mandatory.
2678 Return undef if it fails.
2685 return unless(%invoice and $invoice{invoiceid
});
2687 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2688 closedate shipmentcost shipmentcost_budgetid);
2692 foreach my $key (keys %invoice) {
2693 if(0 < grep { $_ eq $key } @columns) {
2694 push @set_strs, "$key = ?";
2695 push @set_args, ($invoice{$key} || undef);
2699 my $dbh = C4
::Context
->dbh;
2700 my $query = "UPDATE aqinvoices SET ";
2701 $query .= join(",", @set_strs);
2702 $query .= " WHERE invoiceid = ?";
2704 my $sth = $dbh->prepare($query);
2705 $sth->execute(@set_args, $invoice{invoiceid
});
2710 CloseInvoice($invoiceid);
2714 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2719 my ($invoiceid) = @_;
2721 return unless $invoiceid;
2723 my $dbh = C4
::Context
->dbh;
2726 SET closedate
= CAST
(NOW
() AS DATE
)
2729 my $sth = $dbh->prepare($query);
2730 $sth->execute($invoiceid);
2733 =head3 ReopenInvoice
2735 ReopenInvoice($invoiceid);
2739 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2744 my ($invoiceid) = @_;
2746 return unless $invoiceid;
2748 my $dbh = C4
::Context
->dbh;
2751 SET closedate
= NULL
2754 my $sth = $dbh->prepare($query);
2755 $sth->execute($invoiceid);
2760 DelInvoice($invoiceid);
2762 Delete an invoice if there are no items attached to it.
2767 my ($invoiceid) = @_;
2769 return unless $invoiceid;
2771 my $dbh = C4
::Context
->dbh;
2777 my $sth = $dbh->prepare($query);
2778 $sth->execute($invoiceid);
2779 my $res = $sth->fetchrow_arrayref;
2780 if ( $res && $res->[0] == 0 ) {
2782 DELETE FROM aqinvoices
2785 my $sth = $dbh->prepare($query);
2786 return ( $sth->execute($invoiceid) > 0 );
2791 =head3 MergeInvoices
2793 MergeInvoices($invoiceid, \@sourceids);
2795 Merge the invoices identified by the IDs in \@sourceids into
2796 the invoice identified by $invoiceid.
2801 my ($invoiceid, $sourceids) = @_;
2803 return unless $invoiceid;
2804 foreach my $sourceid (@
$sourceids) {
2805 next if $sourceid == $invoiceid;
2806 my $source = GetInvoiceDetails
($sourceid);
2807 foreach my $order (@
{$source->{'orders'}}) {
2808 $order->{'invoiceid'} = $invoiceid;
2811 DelInvoice
($source->{'invoiceid'});
2816 =head3 GetBiblioCountByBasketno
2818 $biblio_count = &GetBiblioCountByBasketno($basketno);
2820 Looks up the biblio's count that has basketno value $basketno
2826 sub GetBiblioCountByBasketno
{
2827 my ($basketno) = @_;
2828 my $dbh = C4
::Context
->dbh;
2830 SELECT COUNT( DISTINCT( biblionumber ) )
2833 AND datecancellationprinted IS NULL
2836 my $sth = $dbh->prepare($query);
2837 $sth->execute($basketno);
2838 return $sth->fetchrow;
2841 =head3 populate_order_with_prices
2843 $order = populate_order_with_prices({
2844 order => $order #a hashref with the order values
2845 booksellerid => $booksellerid #FIXME - should obtain from order basket
2846 receiving => 1 # boolean representing order stage, should pass only this or ordering
2847 ordering => 1 # boolean representing order stage
2851 Sets calculated values for an order - all values are stored with full precision
2852 regardless of rounding preference except for tax value which is calculated
2853 on rounded values if requested
2855 For ordering the values set are:
2860 tax_value_on_ordering
2861 For receiving the value set are:
2862 unitprice_tax_included
2863 unitprice_tax_excluded
2864 tax_value_on_receiving
2866 Note: When receiving, if the rounded value of the unitprice matches the rounded
2867 value of the ecost then then ecost (full precision) is used.
2869 Returns a hashref of the order
2871 FIXME: Move this to Koha::Acquisition::Order.pm
2875 sub populate_order_with_prices
{
2878 my $order = $params->{order
};
2879 my $booksellerid = $params->{booksellerid
};
2880 return unless $booksellerid;
2882 my $bookseller = Koha
::Acquisition
::Booksellers
->find( $booksellerid );
2884 my $receiving = $params->{receiving
};
2885 my $ordering = $params->{ordering
};
2886 my $discount = $order->{discount
};
2887 $discount /= 100 if $discount > 1;
2890 $order->{tax_rate_on_ordering
} //= $order->{tax_rate
};
2891 if ( $bookseller->listincgst ) {
2893 # The user entered the prices tax included
2894 $order->{unitprice
} += 0;
2895 $order->{unitprice_tax_included
} = $order->{unitprice
};
2896 $order->{rrp_tax_included
} = $order->{rrp
};
2898 # price tax excluded = price tax included / ( 1 + tax rate )
2899 $order->{unitprice_tax_excluded
} = $order->{unitprice_tax_included
} / ( 1 + $order->{tax_rate_on_ordering
} );
2900 $order->{rrp_tax_excluded
} = $order->{rrp_tax_included
} / ( 1 + $order->{tax_rate_on_ordering
} );
2902 # ecost tax included = rrp tax included ( 1 - discount )
2903 $order->{ecost_tax_included
} = $order->{rrp_tax_included
} * ( 1 - $discount );
2905 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2906 $order->{ecost_tax_excluded
} = $order->{rrp_tax_excluded
} * ( 1 - $discount );
2908 # tax value = quantity * ecost tax excluded * tax rate
2909 # we should use the unitprice if included
2910 my $cost_tax_included = $order->{unitprice_tax_included
} || $order->{ecost_tax_included
};
2911 my $cost_tax_excluded = $order->{unitprice_tax_excluded
} || $order->{ecost_tax_excluded
};
2912 $order->{tax_value_on_ordering
} = ( get_rounded_price
($cost_tax_included) - get_rounded_price
($cost_tax_excluded) ) * $order->{quantity
};
2916 # The user entered the prices tax excluded
2917 $order->{unitprice_tax_excluded
} = $order->{unitprice
};
2918 $order->{rrp_tax_excluded
} = $order->{rrp
};
2920 # price tax included = price tax excluded * ( 1 - tax rate )
2921 $order->{unitprice_tax_included
} = $order->{unitprice_tax_excluded
} * ( 1 + $order->{tax_rate_on_ordering
} );
2922 $order->{rrp_tax_included
} = $order->{rrp_tax_excluded
} * ( 1 + $order->{tax_rate_on_ordering
} );
2924 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2925 $order->{ecost_tax_excluded
} = $order->{rrp_tax_excluded
} * ( 1 - $discount );
2927 # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount ) = ecost tax excluded * ( 1 + tax rate )
2928 $order->{ecost_tax_included
} = $order->{ecost_tax_excluded
} * ( 1 + $order->{tax_rate_on_ordering
} );
2930 # tax value = quantity * ecost tax included * tax rate
2931 # we should use the unitprice if included
2932 my $cost_tax_excluded = $order->{unitprice_tax_excluded
} || $order->{ecost_tax_excluded
};
2933 $order->{tax_value_on_ordering
} = $order->{quantity
} * get_rounded_price
($cost_tax_excluded) * $order->{tax_rate_on_ordering
};
2938 $order->{tax_rate_on_receiving
} //= $order->{tax_rate
};
2939 if ( $bookseller->invoiceincgst ) {
2940 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2941 # we need to keep the exact ecost value
2942 if ( Koha
::Number
::Price
->new( $order->{unitprice
} )->round == Koha
::Number
::Price
->new( $order->{ecost_tax_included
} )->round ) {
2943 $order->{unitprice
} = $order->{ecost_tax_included
};
2946 # The user entered the unit price tax included
2947 $order->{unitprice_tax_included
} = $order->{unitprice
};
2949 # unit price tax excluded = unit price tax included / ( 1 + tax rate )
2950 $order->{unitprice_tax_excluded
} = $order->{unitprice_tax_included
} / ( 1 + $order->{tax_rate_on_receiving
} );
2953 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2954 # we need to keep the exact ecost value
2955 if ( Koha
::Number
::Price
->new( $order->{unitprice
} )->round == Koha
::Number
::Price
->new( $order->{ecost_tax_excluded
} )->round ) {
2956 $order->{unitprice
} = $order->{ecost_tax_excluded
};
2959 # The user entered the unit price tax excluded
2960 $order->{unitprice_tax_excluded
} = $order->{unitprice
};
2963 # unit price tax included = unit price tax included * ( 1 + tax rate )
2964 $order->{unitprice_tax_included
} = $order->{unitprice_tax_excluded
} * ( 1 + $order->{tax_rate_on_receiving
} );
2967 # tax value = quantity * unit price tax excluded * tax rate
2968 $order->{tax_value_on_receiving
} = $order->{quantity
} * get_rounded_price
($order->{unitprice_tax_excluded
}) * $order->{tax_rate_on_receiving
};
2974 =head3 GetOrderUsers
2976 $order_users_ids = &GetOrderUsers($ordernumber);
2978 Returns a list of all borrowernumbers that are in order users list
2983 my ($ordernumber) = @_;
2985 return unless $ordernumber;
2988 SELECT borrowernumber
2990 WHERE ordernumber
= ?
2992 my $dbh = C4
::Context
->dbh;
2993 my $sth = $dbh->prepare($query);
2994 $sth->execute($ordernumber);
2995 my $results = $sth->fetchall_arrayref( {} );
2997 my @borrowernumbers;
2998 foreach (@
$results) {
2999 push @borrowernumbers, $_->{'borrowernumber'};
3002 return @borrowernumbers;
3005 =head3 ModOrderUsers
3007 my @order_users_ids = (1, 2, 3);
3008 &ModOrderUsers($ordernumber, @basketusers_ids);
3010 Delete all users from order users list, and add users in C<@order_users_ids>
3016 my ( $ordernumber, @order_users_ids ) = @_;
3018 return unless $ordernumber;
3020 my $dbh = C4
::Context
->dbh;
3022 DELETE FROM aqorder_users
3023 WHERE ordernumber
= ?
3025 my $sth = $dbh->prepare($query);
3026 $sth->execute($ordernumber);
3029 INSERT INTO aqorder_users
(ordernumber
, borrowernumber
)
3032 $sth = $dbh->prepare($query);
3033 foreach my $order_user_id (@order_users_ids) {
3034 $sth->execute( $ordernumber, $order_user_id );
3038 sub NotifyOrderUsers
{
3039 my ($ordernumber) = @_;
3041 my @borrowernumbers = GetOrderUsers
($ordernumber);
3042 return unless @borrowernumbers;
3044 my $order = GetOrder
( $ordernumber );
3045 for my $borrowernumber (@borrowernumbers) {
3046 my $patron = Koha
::Patrons
->find( $borrowernumber );
3047 my $library = $patron->library->unblessed;
3048 my $biblio = Koha
::Biblios
->find( $order->{biblionumber
} )->unblessed;
3049 my $letter = C4
::Letters
::GetPreparedLetter
(
3050 module
=> 'acquisition',
3051 letter_code
=> 'ACQ_NOTIF_ON_RECEIV',
3052 branchcode
=> $library->{branchcode
},
3053 lang
=> $patron->lang,
3055 'branches' => $library,
3056 'borrowers' => $patron->unblessed,
3057 'biblio' => $biblio,
3058 'aqorders' => $order,
3062 C4
::Letters
::EnqueueLetter
(
3065 borrowernumber
=> $borrowernumber,
3066 LibraryName
=> C4
::Context
->preference("LibraryName"),
3067 message_transport_type
=> 'email',
3069 ) or warn "can't enqueue letter $letter";
3074 =head3 FillWithDefaultValues
3076 FillWithDefaultValues( $marc_record, $params );
3078 This will update the record with default value defined in the ACQ framework.
3079 For all existing fields, if a default value exists and there are no subfield, it will be created.
3080 If the field does not exist, it will be created too.
3082 If the parameter only_mandatory => 1 is passed via $params, only the mandatory
3083 defaults are being applied to the record.
3087 sub FillWithDefaultValues
{
3088 my ( $record, $params ) = @_;
3089 my $mandatory = $params->{only_mandatory
};
3090 my $tagslib = C4
::Biblio
::GetMarcStructure
( 1, 'ACQ', { unsafe
=> 1 } );
3093 C4
::Biblio
::GetMarcFromKohaField
( 'items.itemnumber' );
3094 for my $tag ( sort keys %$tagslib ) {
3096 next if $tag == $itemfield;
3097 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3098 next if IsMarcStructureInternal
($tagslib->{$tag}{$subfield});
3099 next if $mandatory && !$tagslib->{$tag}{$subfield}{mandatory
};
3100 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue
};
3101 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3102 my @fields = $record->field($tag);
3104 for my $field (@fields) {
3105 if ( $field->is_control_field ) {
3106 $field->update($defaultvalue) if not defined $field->data;
3108 elsif ( not defined $field->subfield($subfield) ) {
3109 $field->add_subfields(
3110 $subfield => $defaultvalue );
3115 if ( $tag < 10 ) { # is_control_field
3116 $record->insert_fields_ordered(
3123 $record->insert_fields_ordered(
3125 $tag, '', '', $subfield => $defaultvalue
3141 Koha Development Team <http://koha-community.org/>