1 package C4
::Acquisition
;
3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
29 use C4
::Templates
qw(gettemplate);
30 use Koha
::DateUtils
qw( dt_from_string output_pref );
31 use Koha
::Acquisition
::Booksellers
;
32 use Koha
::Acquisition
::Orders
;
35 use Koha
::Number
::Price
;
37 use Koha
::CsvProfiles
;
47 use vars
qw(@ISA @EXPORT);
53 &GetBasket &NewBasket &CloseBasket &ReopenBasket &DelBasket &ModBasket
54 &GetBasketAsCSV &GetBasketGroupAsCSV
55 &GetBasketsByBookseller &GetBasketsByBasketgroup
56 &GetBasketsInfosByBookseller
58 &GetBasketUsers &ModBasketUsers
63 &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup
64 &GetBasketgroups &ReOpenBasketgroup
66 &DelOrder &ModOrder &GetOrder &GetOrders &GetOrdersByBiblionumber
67 &GetLateOrders &GetOrderFromItemnumber
68 &SearchOrders &GetHistory &GetRecentAcqui
69 &ModReceiveOrder &CancelReceipt
71 &GetLastOrderNotReceivedFromSubscriptionid &GetLastOrderReceivedFromSubscriptionid
86 &GetItemnumbersFromOrder
89 &GetBiblioCountByBasketno
95 &FillWithDefaultValues
103 sub GetOrderFromItemnumber
{
104 my ($itemnumber) = @_;
105 my $dbh = C4
::Context
->dbh;
108 SELECT
* from aqorders LEFT JOIN aqorders_items
109 ON
( aqorders
.ordernumber
= aqorders_items
.ordernumber
)
110 WHERE itemnumber
= ?
|;
112 my $sth = $dbh->prepare($query);
116 $sth->execute($itemnumber);
118 my $order = $sth->fetchrow_hashref;
123 # Returns the itemnumber(s) associated with the ordernumber given in parameter
124 sub GetItemnumbersFromOrder
{
125 my ($ordernumber) = @_;
126 my $dbh = C4
::Context
->dbh;
127 my $query = "SELECT itemnumber FROM aqorders_items WHERE ordernumber=?";
128 my $sth = $dbh->prepare($query);
129 $sth->execute($ordernumber);
132 while (my $order = $sth->fetchrow_hashref) {
133 push @tab, $order->{'itemnumber'};
147 C4::Acquisition - Koha functions for dealing with orders and acquisitions
155 The functions in this module deal with acquisitions, managing book
156 orders, basket and parcels.
160 =head2 FUNCTIONS ABOUT BASKETS
164 $aqbasket = &GetBasket($basketnumber);
166 get all basket informations in aqbasket for a given basket
168 B<returns:> informations for a given basket returned as a hashref.
174 my $dbh = C4
::Context
->dbh;
177 concat( b.firstname,' ',b.surname) AS authorisedbyname
179 LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
182 my $sth=$dbh->prepare($query);
183 $sth->execute($basketno);
184 my $basket = $sth->fetchrow_hashref;
188 #------------------------------------------------------------#
192 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
193 $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace, $is_standing, $create_items );
195 Create a new basket in aqbasket table
199 =item C<$booksellerid> is a foreign key in the aqbasket table
201 =item C<$authorizedby> is the username of who created the basket
205 The other parameters are optional, see ModBasketHeader for more info on them.
210 my ( $booksellerid, $authorisedby, $basketname, $basketnote,
211 $basketbooksellernote, $basketcontractnumber, $deliveryplace,
212 $billingplace, $is_standing, $create_items ) = @_;
213 my $dbh = C4
::Context
->dbh;
215 'INSERT INTO aqbasket (creationdate,booksellerid,authorisedby) '
216 . 'VALUES (now(),?,?)';
217 $dbh->do( $query, {}, $booksellerid, $authorisedby );
219 my $basket = $dbh->{mysql_insertid
};
220 $basketname ||= q{}; # default to empty strings
222 $basketbooksellernote ||= q{};
223 ModBasketHeader
( $basket, $basketname, $basketnote, $basketbooksellernote,
224 $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items );
228 #------------------------------------------------------------#
232 &CloseBasket($basketno);
234 close a basket (becomes unmodifiable, except for receives)
240 my $dbh = C4
::Context
->dbh;
241 $dbh->do('UPDATE aqbasket SET closedate=now() WHERE basketno=?', {}, $basketno );
244 q{UPDATE aqorders SET orderstatus = 'ordered' WHERE basketno = ? AND orderstatus NOT IN ( 'complete', 'cancelled')},
252 &ReopenBasket($basketno);
260 my $dbh = C4
::Context
->dbh;
261 $dbh->do( q{UPDATE aqbasket SET closedate=NULL WHERE basketno=?}, {}, $basketno );
265 SET orderstatus = 'new'
267 AND orderstatus NOT IN ( 'complete', 'cancelled' )
272 #------------------------------------------------------------#
274 =head3 GetBasketAsCSV
276 &GetBasketAsCSV($basketno);
278 Export a basket as CSV
280 $cgi parameter is needed for column name translation
285 my ($basketno, $cgi, $csv_profile_id) = @_;
286 my $basket = GetBasket
($basketno);
287 my @orders = GetOrders
($basketno);
288 my $contract = GetContract
({
289 contractnumber
=> $basket->{'contractnumber'}
292 my $template = C4
::Templates
::gettemplate
("acqui/csv/basket.tt", "intranet", $cgi);
294 if ($csv_profile_id) {
295 my $csv_profile = Koha
::CsvProfiles
->find( $csv_profile_id );
296 die "There is no valid csv profile given" unless $csv_profile;
298 my $csv = Text
::CSV_XS
->new({'quote_char'=>'"','escape_char'=>'"','sep_char'=>$csv_profile->csv_separator,'binary'=>1});
299 my $csv_profile_content = $csv_profile->content;
300 my ( @headers, @fields );
301 while ( $csv_profile_content =~ /
304 ([^\
|]*) # fieldname (table.row or row)
308 my $field = ($2 eq '') ?
$1 : $2;
310 $header =~ s/^\s+|\s+$//g; # Trim whitespaces
311 push @headers, $header;
313 $field =~ s/[^\.]*\.{1}//; # Remove the table name if exists.
314 $field =~ s/^\s+|\s+$//g; # Trim whitespaces
315 push @fields, $field;
317 for my $order (@orders) {
319 my $biblio = Koha
::Biblios
->find( $order->{biblionumber
} );
320 my $biblioitem = $biblio->biblioitem;
321 $order = { %$order, %{ $biblioitem->unblessed } };
323 $order = {%$order, %$contract};
325 $order = {%$order, %$basket, %{ $biblio->unblessed }};
326 for my $field (@fields) {
327 push @row, $order->{$field};
331 my $content = join( $csv_profile->csv_separator, @headers ) . "\n";
332 for my $row ( @rows ) {
333 $csv->combine(@
$row);
334 my $string = $csv->string;
335 $content .= $string . "\n";
340 foreach my $order (@orders) {
341 my $biblio = Koha
::Biblios
->find( $order->{biblionumber
} );
342 my $biblioitem = $biblio->biblioitem;
344 contractname
=> $contract->{'contractname'},
345 ordernumber
=> $order->{'ordernumber'},
346 entrydate
=> $order->{'entrydate'},
347 isbn
=> $order->{'isbn'},
348 author
=> $biblio->author,
349 title
=> $biblio->title,
350 publicationyear
=> $biblioitem->publicationyear,
351 publishercode
=> $biblioitem->publishercode,
352 collectiontitle
=> $biblioitem->collectiontitle,
353 notes
=> $order->{'order_vendornote'},
354 quantity
=> $order->{'quantity'},
355 rrp
=> $order->{'rrp'},
357 for my $place ( qw( deliveryplace billingplace ) ) {
358 if ( my $library = Koha
::Libraries
->find( $row->{deliveryplace
} ) ) {
359 $row->{$place} = $library->branchname
363 contractname author title publishercode collectiontitle notes
364 deliveryplace billingplace
366 # Double the quotes to not be interpreted as a field end
367 $row->{$_} =~ s/"/""/g if $row->{$_};
373 if(defined $a->{publishercode
} and defined $b->{publishercode
}) {
374 $a->{publishercode
} cmp $b->{publishercode
};
378 $template->param(rows
=> \
@rows);
380 return $template->output;
385 =head3 GetBasketGroupAsCSV
387 &GetBasketGroupAsCSV($basketgroupid);
389 Export a basket group as CSV
391 $cgi parameter is needed for column name translation
395 sub GetBasketGroupAsCSV
{
396 my ($basketgroupid, $cgi) = @_;
397 my $baskets = GetBasketsByBasketgroup
($basketgroupid);
399 my $template = C4
::Templates
::gettemplate
('acqui/csv/basketgroup.tt', 'intranet', $cgi);
402 for my $basket (@
$baskets) {
403 my @orders = GetOrders
( $basket->{basketno
} );
404 my $contract = GetContract
({
405 contractnumber
=> $basket->{contractnumber
}
407 my $bookseller = Koha
::Acquisition
::Booksellers
->find( $basket->{booksellerid
} );
408 my $basketgroup = GetBasketgroup
( $$basket{basketgroupid
} );
410 foreach my $order (@orders) {
411 my $biblio = Koha
::Biblios
->find( $order->{biblionumber
} );
412 my $biblioitem = $biblio->biblioitem;
414 clientnumber
=> $bookseller->accountnumber,
415 basketname
=> $basket->{basketname
},
416 ordernumber
=> $order->{ordernumber
},
417 author
=> $biblio->author,
418 title
=> $biblio->title,
419 publishercode
=> $biblioitem->publishercode,
420 publicationyear
=> $biblioitem->publicationyear,
421 collectiontitle
=> $biblioitem->collectiontitle,
422 isbn
=> $order->{isbn
},
423 quantity
=> $order->{quantity
},
424 rrp_tax_included
=> $order->{rrp_tax_included
},
425 rrp_tax_excluded
=> $order->{rrp_tax_excluded
},
426 discount
=> $bookseller->discount,
427 ecost_tax_included
=> $order->{ecost_tax_included
},
428 ecost_tax_excluded
=> $order->{ecost_tax_excluded
},
429 notes
=> $order->{order_vendornote
},
430 entrydate
=> $order->{entrydate
},
431 booksellername
=> $bookseller->name,
432 bookselleraddress
=> $bookseller->address1,
433 booksellerpostal
=> $bookseller->postal,
434 contractnumber
=> $contract->{contractnumber
},
435 contractname
=> $contract->{contractname
},
438 basketgroupdeliveryplace
=> $basketgroup->{deliveryplace
},
439 basketgroupbillingplace
=> $basketgroup->{billingplace
},
440 basketdeliveryplace
=> $basket->{deliveryplace
},
441 basketbillingplace
=> $basket->{billingplace
},
443 for my $place (qw( basketgroupdeliveryplace basketgroupbillingplace basketdeliveryplace basketbillingplace )) {
444 if ( my $library = Koha
::Libraries
->find( $temp->{$place} ) ) {
445 $row->{$place} = $library->branchname;
449 basketname author title publishercode collectiontitle notes
450 booksellername bookselleraddress booksellerpostal contractname
451 basketgroupdeliveryplace basketgroupbillingplace
452 basketdeliveryplace basketbillingplace
454 # Double the quotes to not be interpreted as a field end
455 $row->{$_} =~ s/"/""/g if $row->{$_};
460 $template->param(rows
=> \
@rows);
462 return $template->output;
466 =head3 CloseBasketgroup
468 &CloseBasketgroup($basketgroupno);
474 sub CloseBasketgroup
{
475 my ($basketgroupno) = @_;
476 my $dbh = C4
::Context
->dbh;
477 my $sth = $dbh->prepare("
478 UPDATE aqbasketgroups
482 $sth->execute($basketgroupno);
485 #------------------------------------------------------------#
487 =head3 ReOpenBaskergroup($basketgroupno)
489 &ReOpenBaskergroup($basketgroupno);
495 sub ReOpenBasketgroup
{
496 my ($basketgroupno) = @_;
497 my $dbh = C4
::Context
->dbh;
498 my $sth = $dbh->prepare("
499 UPDATE aqbasketgroups
503 $sth->execute($basketgroupno);
506 #------------------------------------------------------------#
511 &DelBasket($basketno);
513 Deletes the basket that has basketno field $basketno in the aqbasket table.
517 =item C<$basketno> is the primary key of the basket in the aqbasket table.
524 my ( $basketno ) = @_;
525 my $query = "DELETE FROM aqbasket WHERE basketno=?";
526 my $dbh = C4
::Context
->dbh;
527 my $sth = $dbh->prepare($query);
528 $sth->execute($basketno);
532 #------------------------------------------------------------#
536 &ModBasket($basketinfo);
538 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
542 =item C<$basketno> is the primary key of the basket in the aqbasket table.
549 my $basketinfo = shift;
550 my $query = "UPDATE aqbasket SET ";
552 foreach my $key (keys %$basketinfo){
553 if ($key ne 'basketno'){
554 $query .= "$key=?, ";
555 push(@params, $basketinfo->{$key} || undef );
558 # get rid of the "," at the end of $query
559 if (substr($query, length($query)-2) eq ', '){
564 $query .= "WHERE basketno=?";
565 push(@params, $basketinfo->{'basketno'});
566 my $dbh = C4
::Context
->dbh;
567 my $sth = $dbh->prepare($query);
568 $sth->execute(@params);
573 #------------------------------------------------------------#
575 =head3 ModBasketHeader
577 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
579 Modifies a basket's header.
583 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
585 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
587 =item C<$note> is the "note" field in the "aqbasket" table;
589 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
591 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
593 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
595 =item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
597 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
599 =item C<$is_standing> is the "is_standing" field in the aqbasket table.
601 =item C<$create_items> should be set to 'ordering', 'receiving' or 'cataloguing' (or undef, in which
602 case the AcqCreateItem syspref takes precedence).
608 sub ModBasketHeader
{
609 my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items) = @_;
614 SET basketname
=?
, note
=?
, booksellernote
=?
, booksellerid
=?
, deliveryplace
=?
, billingplace
=?
, is_standing
=?
, create_items
=?
618 my $dbh = C4
::Context
->dbh;
619 my $sth = $dbh->prepare($query);
620 $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items || undef, $basketno);
622 if ( $contractnumber ) {
623 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
624 my $sth2 = $dbh->prepare($query2);
625 $sth2->execute($contractnumber,$basketno);
630 #------------------------------------------------------------#
632 =head3 GetBasketsByBookseller
634 @results = &GetBasketsByBookseller($booksellerid, $extra);
636 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
640 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
642 =item C<$extra> is the extra sql parameters, can be
644 $extra->{groupby}: group baskets by column
645 ex. $extra->{groupby} = aqbasket.basketgroupid
646 $extra->{orderby}: order baskets by column
647 $extra->{limit}: limit number of results (can be helpful for pagination)
653 sub GetBasketsByBookseller
{
654 my ($booksellerid, $extra) = @_;
655 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
657 if ($extra->{groupby
}) {
658 $query .= " GROUP by $extra->{groupby}";
660 if ($extra->{orderby
}){
661 $query .= " ORDER by $extra->{orderby}";
663 if ($extra->{limit
}){
664 $query .= " LIMIT $extra->{limit}";
667 my $dbh = C4
::Context
->dbh;
668 my $sth = $dbh->prepare($query);
669 $sth->execute($booksellerid);
670 return $sth->fetchall_arrayref({});
673 =head3 GetBasketsInfosByBookseller
675 my $baskets = GetBasketsInfosByBookseller($supplierid, $allbaskets);
677 The optional second parameter allbaskets is a boolean allowing you to
678 select all baskets from the supplier; by default only active baskets (open or
679 closed but still something to receive) are returned.
681 Returns in a arrayref of hashref all about booksellers baskets, plus:
682 total_biblios: Number of distinct biblios in basket
683 total_items: Number of items in basket
684 expected_items: Number of non-received items in basket
688 sub GetBasketsInfosByBookseller
{
689 my ($supplierid, $allbaskets) = @_;
691 return unless $supplierid;
693 my $dbh = C4
::Context
->dbh;
695 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,
696 SUM(aqorders.quantity) AS total_items,
698 IF ( aqorders.orderstatus = 'cancelled', aqorders.quantity, 0 )
699 ) AS total_items_cancelled,
700 COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
702 IF(aqorders.datereceived IS NULL
703 AND aqorders.datecancellationprinted IS NULL
708 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
709 WHERE booksellerid = ?};
711 unless ( $allbaskets ) {
712 $query.=" AND (closedate IS NULL OR (aqorders.quantity > aqorders.quantityreceived AND datecancellationprinted IS NULL))";
714 $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";
716 my $sth = $dbh->prepare($query);
717 $sth->execute($supplierid);
718 my $baskets = $sth->fetchall_arrayref({});
720 # Retrieve the number of biblios cancelled
721 my $cancelled_biblios = $dbh->selectall_hashref( q
|
722 SELECT COUNT
(DISTINCT
(biblionumber
)) AS total_biblios_cancelled
, aqbasket
.basketno
724 LEFT JOIN aqorders ON aqorders
.basketno
= aqbasket
.basketno
725 WHERE booksellerid
= ?
726 AND aqorders
.orderstatus
= 'cancelled'
727 GROUP BY aqbasket
.basketno
728 |, 'basketno', {}, $supplierid );
730 $_->{total_biblios_cancelled
} = $cancelled_biblios->{$_->{basketno
}}{total_biblios_cancelled
} || 0
736 =head3 GetBasketUsers
738 $basketusers_ids = &GetBasketUsers($basketno);
740 Returns a list of all borrowernumbers that are in basket users list
745 my $basketno = shift;
747 return unless $basketno;
750 SELECT borrowernumber
754 my $dbh = C4
::Context
->dbh;
755 my $sth = $dbh->prepare($query);
756 $sth->execute($basketno);
757 my $results = $sth->fetchall_arrayref( {} );
760 foreach (@
$results) {
761 push @borrowernumbers, $_->{'borrowernumber'};
764 return @borrowernumbers;
767 =head3 ModBasketUsers
769 my @basketusers_ids = (1, 2, 3);
770 &ModBasketUsers($basketno, @basketusers_ids);
772 Delete all users from basket users list, and add users in C<@basketusers_ids>
778 my ($basketno, @basketusers_ids) = @_;
780 return unless $basketno;
782 my $dbh = C4
::Context
->dbh;
784 DELETE FROM aqbasketusers
787 my $sth = $dbh->prepare($query);
788 $sth->execute($basketno);
791 INSERT INTO aqbasketusers
(basketno
, borrowernumber
)
794 $sth = $dbh->prepare($query);
795 foreach my $basketuser_id (@basketusers_ids) {
796 $sth->execute($basketno, $basketuser_id);
801 =head3 CanUserManageBasket
803 my $bool = CanUserManageBasket($borrower, $basket[, $userflags]);
804 my $bool = CanUserManageBasket($borrowernumber, $basketno[, $userflags]);
806 Check if a borrower can manage a basket, according to system preference
807 AcqViewBaskets, user permissions and basket properties (creator, users list,
810 First parameter can be either a borrowernumber or a hashref as returned by
811 Koha::Patron->unblessed
813 Second parameter can be either a basketno or a hashref as returned by
814 C4::Acquisition::GetBasket.
816 The third parameter is optional. If given, it should be a hashref as returned
817 by C4::Auth::getuserflags. If not, getuserflags is called.
819 If user is authorised to manage basket, returns 1.
824 sub CanUserManageBasket
{
825 my ($borrower, $basket, $userflags) = @_;
827 if (!ref $borrower) {
828 # FIXME This needs to be replaced
829 # We should not accept both scalar and array
830 # Tests need to be updated
831 $borrower = Koha
::Patrons
->find( $borrower )->unblessed;
834 $basket = GetBasket
($basket);
837 return 0 unless ($basket and $borrower);
839 my $borrowernumber = $borrower->{borrowernumber
};
840 my $basketno = $basket->{basketno
};
842 my $AcqViewBaskets = C4
::Context
->preference('AcqViewBaskets');
844 if (!defined $userflags) {
845 my $dbh = C4
::Context
->dbh;
846 my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE borrowernumber = ?");
847 $sth->execute($borrowernumber);
848 my ($flags) = $sth->fetchrow_array;
851 $userflags = C4
::Auth
::getuserflags
($flags, $borrower->{userid
}, $dbh);
854 unless ($userflags->{superlibrarian
}
855 || (ref $userflags->{acquisition
} && $userflags->{acquisition
}->{order_manage_all
})
856 || (!ref $userflags->{acquisition
} && $userflags->{acquisition
}))
858 if (not exists $userflags->{acquisition
}) {
862 if ( (ref $userflags->{acquisition
} && !$userflags->{acquisition
}->{order_manage
})
863 || (!ref $userflags->{acquisition
} && !$userflags->{acquisition
}) ) {
867 if ($AcqViewBaskets eq 'user'
868 && $basket->{authorisedby
} != $borrowernumber
869 && ! grep { $borrowernumber eq $_ } GetBasketUsers
($basketno)) {
873 if ($AcqViewBaskets eq 'branch' && defined $basket->{branch
}
874 && $basket->{branch
} ne $borrower->{branchcode
}) {
882 #------------------------------------------------------------#
884 =head3 GetBasketsByBasketgroup
886 $baskets = &GetBasketsByBasketgroup($basketgroupid);
888 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
892 sub GetBasketsByBasketgroup
{
893 my $basketgroupid = shift;
895 SELECT
*, aqbasket
.booksellerid as booksellerid
897 LEFT JOIN aqcontract USING
(contractnumber
) WHERE basketgroupid
=?
899 my $dbh = C4
::Context
->dbh;
900 my $sth = $dbh->prepare($query);
901 $sth->execute($basketgroupid);
902 return $sth->fetchall_arrayref({});
905 #------------------------------------------------------------#
907 =head3 NewBasketgroup
909 $basketgroupid = NewBasketgroup(\%hashref);
911 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
913 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
915 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
917 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
919 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
921 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
923 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
925 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
927 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
932 my $basketgroupinfo = shift;
933 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
934 my $query = "INSERT INTO aqbasketgroups (";
936 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
937 if ( defined $basketgroupinfo->{$field} ) {
938 $query .= "$field, ";
939 push(@params, $basketgroupinfo->{$field});
942 $query .= "booksellerid) VALUES (";
947 push(@params, $basketgroupinfo->{'booksellerid'});
948 my $dbh = C4
::Context
->dbh;
949 my $sth = $dbh->prepare($query);
950 $sth->execute(@params);
951 my $basketgroupid = $dbh->{'mysql_insertid'};
952 if( $basketgroupinfo->{'basketlist'} ) {
953 foreach my $basketno (@
{$basketgroupinfo->{'basketlist'}}) {
954 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
955 my $sth2 = $dbh->prepare($query2);
956 $sth2->execute($basketgroupid, $basketno);
959 return $basketgroupid;
962 #------------------------------------------------------------#
964 =head3 ModBasketgroup
966 ModBasketgroup(\%hashref);
968 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
970 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
972 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
974 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
976 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
978 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
980 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
982 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
984 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
989 my $basketgroupinfo = shift;
990 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
991 my $dbh = C4
::Context
->dbh;
992 my $query = "UPDATE aqbasketgroups SET ";
994 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
995 if ( defined $basketgroupinfo->{$field} ) {
996 $query .= "$field=?, ";
997 push(@params, $basketgroupinfo->{$field});
1002 $query .= " WHERE id=?";
1003 push(@params, $basketgroupinfo->{'id'});
1004 my $sth = $dbh->prepare($query);
1005 $sth->execute(@params);
1007 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
1008 $sth->execute($basketgroupinfo->{'id'});
1010 if($basketgroupinfo->{'basketlist'} && @
{$basketgroupinfo->{'basketlist'}}){
1011 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
1012 foreach my $basketno (@
{$basketgroupinfo->{'basketlist'}}) {
1013 $sth->execute($basketgroupinfo->{'id'}, $basketno);
1019 #------------------------------------------------------------#
1021 =head3 DelBasketgroup
1023 DelBasketgroup($basketgroupid);
1025 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
1029 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
1035 sub DelBasketgroup
{
1036 my $basketgroupid = shift;
1037 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1038 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
1039 my $dbh = C4
::Context
->dbh;
1040 my $sth = $dbh->prepare($query);
1041 $sth->execute($basketgroupid);
1045 #------------------------------------------------------------#
1048 =head2 FUNCTIONS ABOUT ORDERS
1050 =head3 GetBasketgroup
1052 $basketgroup = &GetBasketgroup($basketgroupid);
1054 Returns a reference to the hash containing all information about the basketgroup.
1058 sub GetBasketgroup
{
1059 my $basketgroupid = shift;
1060 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1061 my $dbh = C4
::Context
->dbh;
1062 my $result_set = $dbh->selectall_arrayref(
1063 'SELECT * FROM aqbasketgroups WHERE id=?',
1067 return $result_set->[0]; # id is unique
1070 #------------------------------------------------------------#
1072 =head3 GetBasketgroups
1074 $basketgroups = &GetBasketgroups($booksellerid);
1076 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
1080 sub GetBasketgroups
{
1081 my $booksellerid = shift;
1082 die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
1083 my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
1084 my $dbh = C4
::Context
->dbh;
1085 my $sth = $dbh->prepare($query);
1086 $sth->execute($booksellerid);
1087 return $sth->fetchall_arrayref({});
1090 #------------------------------------------------------------#
1092 =head2 FUNCTIONS ABOUT ORDERS
1096 @orders = &GetOrders( $basketno, { orderby => 'biblio.title', cancelled => 0|1 } );
1098 Looks up the pending (non-cancelled) orders with the given basket
1101 If cancelled is set, only cancelled orders will be returned.
1106 my ( $basketno, $params ) = @_;
1108 return () unless $basketno;
1110 my $orderby = $params->{orderby
};
1111 my $cancelled = $params->{cancelled
} || 0;
1113 my $dbh = C4
::Context
->dbh;
1115 SELECT biblio
.*,biblioitems
.*,
1119 $query .= $cancelled
1121 aqorders_transfers
.ordernumber_to AS transferred_to
,
1122 aqorders_transfers
.timestamp AS transferred_to_timestamp
1125 aqorders_transfers
.ordernumber_from AS transferred_from
,
1126 aqorders_transfers
.timestamp AS transferred_from_timestamp
1130 LEFT JOIN aqbudgets ON aqbudgets
.budget_id
= aqorders
.budget_id
1131 LEFT JOIN biblio ON biblio
.biblionumber
= aqorders
.biblionumber
1132 LEFT JOIN biblioitems ON biblioitems
.biblionumber
=biblio
.biblionumber
1134 $query .= $cancelled
1136 LEFT JOIN aqorders_transfers ON aqorders_transfers
.ordernumber_from
= aqorders
.ordernumber
1139 LEFT JOIN aqorders_transfers ON aqorders_transfers
.ordernumber_to
= aqorders
.ordernumber
1147 $orderby ||= q
|biblioitems
.publishercode
, biblio
.title
|;
1149 AND
(datecancellationprinted IS NOT NULL
1150 AND datecancellationprinted
<> '0000-00-00')
1155 q
|aqorders
.datecancellationprinted desc
, aqorders
.timestamp desc
|;
1157 AND
(datecancellationprinted IS NULL OR datecancellationprinted
='0000-00-00')
1161 $query .= " ORDER BY $orderby";
1163 $dbh->selectall_arrayref( $query, { Slice
=> {} }, $basketno );
1168 #------------------------------------------------------------#
1170 =head3 GetOrdersByBiblionumber
1172 @orders = &GetOrdersByBiblionumber($biblionumber);
1174 Looks up the orders with linked to a specific $biblionumber, including
1175 cancelled orders and received orders.
1178 C<@orders> is an array of references-to-hash, whose keys are the
1179 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
1183 sub GetOrdersByBiblionumber
{
1184 my $biblionumber = shift;
1185 return unless $biblionumber;
1186 my $dbh = C4
::Context
->dbh;
1188 SELECT biblio.*,biblioitems.*,
1192 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1193 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1194 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
1195 WHERE aqorders.biblionumber=?
1198 $dbh->selectall_arrayref( $query, { Slice
=> {} }, $biblionumber );
1199 return @
{$result_set};
1203 #------------------------------------------------------------#
1207 $order = &GetOrder($ordernumber);
1209 Looks up an order by order number.
1211 Returns a reference-to-hash describing the order. The keys of
1212 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1217 my ($ordernumber) = @_;
1218 return unless $ordernumber;
1220 my $dbh = C4
::Context
->dbh;
1221 my $query = qq{SELECT
1225 aqbasket
.basketname
,
1226 borrowers
.branchcode
,
1227 biblioitems
.publicationyear
,
1228 biblio
.copyrightdate
,
1229 biblioitems
.editionstatement
,
1233 biblioitems
.publishercode
,
1234 aqorders
.rrp AS unitpricesupplier
,
1235 aqorders
.ecost AS unitpricelib
,
1236 aqorders
.claims_count AS claims_count
,
1237 aqorders
.claimed_date AS claimed_date
,
1238 aqbudgets
.budget_name AS budget
,
1239 aqbooksellers
.name AS supplier
,
1240 aqbooksellers
.id AS supplierid
,
1241 biblioitems
.publishercode AS publisher
,
1242 ADDDATE
(aqbasket
.closedate
, INTERVAL aqbooksellers
.deliverytime DAY
) AS estimateddeliverydate
,
1243 DATE
(aqbasket
.closedate
) AS orderdate
,
1244 aqorders
.quantity
- COALESCE
(aqorders
.quantityreceived
,0) AS quantity_to_receive
,
1245 (aqorders
.quantity
- COALESCE
(aqorders
.quantityreceived
,0)) * aqorders
.rrp AS subtotal
,
1246 DATEDIFF
(CURDATE
( ),closedate
) AS latesince
1247 FROM aqorders LEFT JOIN biblio ON biblio
.biblionumber
= aqorders
.biblionumber
1248 LEFT JOIN biblioitems ON biblioitems
.biblionumber
= biblio
.biblionumber
1249 LEFT JOIN aqbudgets ON aqorders
.budget_id
= aqbudgets
.budget_id
,
1250 aqbasket LEFT JOIN borrowers ON aqbasket
.authorisedby
= borrowers
.borrowernumber
1251 LEFT JOIN aqbooksellers ON aqbasket
.booksellerid
= aqbooksellers
.id
1252 WHERE aqorders
.basketno
= aqbasket
.basketno
1255 $dbh->selectall_arrayref( $query, { Slice
=> {} }, $ordernumber );
1257 # result_set assumed to contain 1 match
1258 return $result_set->[0];
1261 =head3 GetLastOrderNotReceivedFromSubscriptionid
1263 $order = &GetLastOrderNotReceivedFromSubscriptionid($subscriptionid);
1265 Returns a reference-to-hash describing the last order not received for a subscription.
1269 sub GetLastOrderNotReceivedFromSubscriptionid
{
1270 my ( $subscriptionid ) = @_;
1271 my $dbh = C4
::Context
->dbh;
1273 SELECT
* FROM aqorders
1274 LEFT JOIN subscription
1275 ON
( aqorders
.subscriptionid
= subscription
.subscriptionid
)
1276 WHERE aqorders
.subscriptionid
= ?
1277 AND aqorders
.datereceived IS NULL
1281 $dbh->selectall_arrayref( $query, { Slice
=> {} }, $subscriptionid );
1283 # result_set assumed to contain 1 match
1284 return $result_set->[0];
1287 =head3 GetLastOrderReceivedFromSubscriptionid
1289 $order = &GetLastOrderReceivedFromSubscriptionid($subscriptionid);
1291 Returns a reference-to-hash describing the last order received for a subscription.
1295 sub GetLastOrderReceivedFromSubscriptionid
{
1296 my ( $subscriptionid ) = @_;
1297 my $dbh = C4
::Context
->dbh;
1299 SELECT
* FROM aqorders
1300 LEFT JOIN subscription
1301 ON
( aqorders
.subscriptionid
= subscription
.subscriptionid
)
1302 WHERE aqorders
.subscriptionid
= ?
1303 AND aqorders
.datereceived
=
1305 SELECT MAX
( aqorders
.datereceived
)
1307 LEFT JOIN subscription
1308 ON
( aqorders
.subscriptionid
= subscription
.subscriptionid
)
1309 WHERE aqorders
.subscriptionid
= ?
1310 AND aqorders
.datereceived IS NOT NULL
1312 ORDER BY ordernumber DESC
1316 $dbh->selectall_arrayref( $query, { Slice
=> {} }, $subscriptionid, $subscriptionid );
1318 # result_set assumed to contain 1 match
1319 return $result_set->[0];
1323 #------------------------------------------------------------#
1327 &ModOrder(\%hashref);
1329 Modifies an existing order. Updates the order with order number
1330 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1331 other keys of the hash update the fields with the same name in the aqorders
1332 table of the Koha database.
1337 my $orderinfo = shift;
1339 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '';
1341 my $dbh = C4
::Context
->dbh;
1344 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1345 $orderinfo->{uncertainprice
}=1 if $orderinfo->{uncertainprice
};
1347 # delete($orderinfo->{'branchcode'});
1348 # the hash contains a lot of entries not in aqorders, so get the columns ...
1349 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1351 my $colnames = $sth->{NAME
};
1352 #FIXME Be careful. If aqorders would have columns with diacritics,
1353 #you should need to decode what you get back from NAME.
1354 #See report 10110 and guided_reports.pl
1355 my $query = "UPDATE aqorders SET ";
1357 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1358 # ... and skip hash entries that are not in the aqorders table
1359 # FIXME : probably not the best way to do it (would be better to have a correct hash)
1360 next unless grep(/^$orderinfokey$/, @
$colnames);
1361 $query .= "$orderinfokey=?, ";
1362 push(@params, $orderinfo->{$orderinfokey});
1365 $query .= "timestamp=NOW() WHERE ordernumber=?";
1366 push(@params, $orderinfo->{'ordernumber'} );
1367 $sth = $dbh->prepare($query);
1368 $sth->execute(@params);
1372 #------------------------------------------------------------#
1376 ModItemOrder($itemnumber, $ordernumber);
1378 Modifies the ordernumber of an item in aqorders_items.
1383 my ($itemnumber, $ordernumber) = @_;
1385 return unless ($itemnumber and $ordernumber);
1387 my $dbh = C4
::Context
->dbh;
1389 UPDATE aqorders_items
1391 WHERE itemnumber
= ?
1393 my $sth = $dbh->prepare($query);
1394 return $sth->execute($ordernumber, $itemnumber);
1397 #------------------------------------------------------------#
1399 =head3 ModReceiveOrder
1401 my ( $date_received, $new_ordernumber ) = ModReceiveOrder(
1403 biblionumber => $biblionumber,
1405 quantityreceived => $quantityreceived,
1407 invoice => $invoice,
1408 budget_id => $budget_id,
1409 received_itemnumbers => \@received_itemnumbers,
1410 order_internalnote => $order_internalnote,
1414 Updates an order, to reflect the fact that it was received, at least
1417 If a partial order is received, splits the order into two.
1419 Updates the order with biblionumber C<$biblionumber> and ordernumber
1420 C<$order->{ordernumber}>.
1425 sub ModReceiveOrder
{
1427 my $biblionumber = $params->{biblionumber
};
1428 my $order = { %{ $params->{order
} } }; # Copy the order, we don't want to modify it
1429 my $invoice = $params->{invoice
};
1430 my $quantrec = $params->{quantityreceived
};
1431 my $user = $params->{user
};
1432 my $budget_id = $params->{budget_id
};
1433 my $received_items = $params->{received_items
};
1435 my $dbh = C4
::Context
->dbh;
1436 my $datereceived = ( $invoice and $invoice->{datereceived
} ) ?
$invoice->{datereceived
} : dt_from_string
;
1437 my $suggestionid = GetSuggestionFromBiblionumber
( $biblionumber );
1438 if ($suggestionid) {
1439 ModSuggestion
( {suggestionid
=>$suggestionid,
1440 STATUS
=>'AVAILABLE',
1441 biblionumber
=> $biblionumber}
1445 my $result_set = $dbh->selectrow_arrayref(
1446 q{SELECT aqbasket.is_standing
1448 WHERE basketno=?},{ Slice
=> {} }, $order->{basketno
});
1449 my $is_standing = $result_set->[0]; # we assume we have a unique basket
1451 my $new_ordernumber = $order->{ordernumber
};
1452 if ( $is_standing || $order->{quantity
} > $quantrec ) {
1453 # Split order line in two parts: the first is the original order line
1454 # without received items (the quantity is decreased),
1455 # the second part is a new order line with quantity=quantityrec
1456 # (entirely received)
1460 orderstatus
= 'partial'|;
1461 $query .= q
|, order_internalnote
= ?
| if defined $order->{order_internalnote
};
1462 $query .= q
| WHERE ordernumber
= ?
|;
1463 my $sth = $dbh->prepare($query);
1466 ( $is_standing ?
1 : ($order->{quantity
} - $quantrec) ),
1467 ( defined $order->{order_internalnote
} ?
$order->{order_internalnote
} : () ),
1468 $order->{ordernumber
}
1471 # Recalculate tax_value
1475 tax_value_on_ordering
= quantity
* ecost_tax_excluded
* tax_rate_on_ordering
,
1476 tax_value_on_receiving
= quantity
* unitprice_tax_excluded
* tax_rate_on_receiving
1477 WHERE ordernumber
= ?
1478 |, undef, $order->{ordernumber
});
1480 delete $order->{ordernumber
};
1481 $order->{budget_id
} = ( $budget_id || $order->{budget_id
} );
1482 $order->{quantity
} = $quantrec;
1483 $order->{quantityreceived
} = $quantrec;
1484 $order->{ecost_tax_excluded
} //= 0;
1485 $order->{tax_rate_on_ordering
} //= 0;
1486 $order->{unitprice_tax_excluded
} //= 0;
1487 $order->{tax_rate_on_receiving
} //= 0;
1488 $order->{tax_value_on_ordering
} = $order->{quantity
} * $order->{ecost_tax_excluded
} * $order->{tax_rate_on_ordering
};
1489 $order->{tax_value_on_receiving
} = $order->{quantity
} * $order->{unitprice_tax_excluded
} * $order->{tax_rate_on_receiving
};
1490 $order->{datereceived
} = $datereceived;
1491 $order->{invoiceid
} = $invoice->{invoiceid
};
1492 $order->{orderstatus
} = 'complete';
1493 $new_ordernumber = Koha
::Acquisition
::Order
->new($order)->store->ordernumber; # TODO What if the store fails?
1495 if ($received_items) {
1496 foreach my $itemnumber (@
$received_items) {
1497 ModItemOrder
($itemnumber, $new_ordernumber);
1503 SET quantityreceived
= ?
,
1507 orderstatus
= 'complete'
1511 , replacementprice
= ?
1512 | if defined $order->{replacementprice
};
1515 , unitprice
= ?
, unitprice_tax_included
= ?
, unitprice_tax_excluded
= ?
1516 | if defined $order->{unitprice
};
1519 ,tax_value_on_receiving
= ?
1520 | if defined $order->{tax_value_on_receiving
};
1523 ,tax_rate_on_receiving
= ?
1524 | if defined $order->{tax_rate_on_receiving
};
1527 , order_internalnote
= ?
1528 | if defined $order->{order_internalnote
};
1530 $query .= q
| where biblionumber
=?
and ordernumber
=?
|;
1532 my $sth = $dbh->prepare( $query );
1533 my @params = ( $quantrec, $datereceived, $invoice->{invoiceid
}, ( $budget_id ?
$budget_id : $order->{budget_id
} ) );
1535 if ( defined $order->{replacementprice
} ) {
1536 push @params, $order->{replacementprice
};
1539 if ( defined $order->{unitprice
} ) {
1540 push @params, $order->{unitprice
}, $order->{unitprice_tax_included
}, $order->{unitprice_tax_excluded
};
1543 if ( defined $order->{tax_value_on_receiving
} ) {
1544 push @params, $order->{tax_value_on_receiving
};
1547 if ( defined $order->{tax_rate_on_receiving
} ) {
1548 push @params, $order->{tax_rate_on_receiving
};
1551 if ( defined $order->{order_internalnote
} ) {
1552 push @params, $order->{order_internalnote
};
1555 push @params, ( $biblionumber, $order->{ordernumber
} );
1557 $sth->execute( @params );
1559 # All items have been received, sent a notification to users
1560 NotifyOrderUsers
( $order->{ordernumber
} );
1563 return ($datereceived, $new_ordernumber);
1566 =head3 CancelReceipt
1568 my $parent_ordernumber = CancelReceipt($ordernumber);
1570 Cancel an order line receipt and update the parent order line, as if no
1572 If items are created at receipt (AcqCreateItem = receiving) then delete
1578 my $ordernumber = shift;
1580 return unless $ordernumber;
1582 my $dbh = C4
::Context
->dbh;
1584 SELECT datereceived
, parent_ordernumber
, quantity
1586 WHERE ordernumber
= ?
1588 my $sth = $dbh->prepare($query);
1589 $sth->execute($ordernumber);
1590 my $order = $sth->fetchrow_hashref;
1592 warn "CancelReceipt: order $ordernumber does not exist";
1595 unless($order->{'datereceived'}) {
1596 warn "CancelReceipt: order $ordernumber is not received";
1600 my $parent_ordernumber = $order->{'parent_ordernumber'};
1602 my @itemnumbers = GetItemnumbersFromOrder
( $ordernumber );
1603 my $order_obj = Koha
::Acquisition
::Orders
->find( $ordernumber ); # FIXME rewrite all this subroutine using this object
1605 if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1606 # The order line has no parent, just mark it as not received
1609 SET quantityreceived
= ?
,
1612 orderstatus
= 'ordered'
1613 WHERE ordernumber
= ?
1615 $sth = $dbh->prepare($query);
1616 $sth->execute(0, undef, undef, $ordernumber);
1617 _cancel_items_receipt
( $order_obj );
1619 # The order line has a parent, increase parent quantity and delete
1622 SELECT quantity
, datereceived
1624 WHERE ordernumber
= ?
1626 $sth = $dbh->prepare($query);
1627 $sth->execute($parent_ordernumber);
1628 my $parent_order = $sth->fetchrow_hashref;
1629 unless($parent_order) {
1630 warn "Parent order $parent_ordernumber does not exist.";
1633 if($parent_order->{'datereceived'}) {
1634 warn "CancelReceipt: parent order is received.".
1635 " Can't cancel receipt.";
1641 orderstatus
= 'ordered'
1642 WHERE ordernumber
= ?
1644 $sth = $dbh->prepare($query);
1645 my $rv = $sth->execute(
1646 $order->{'quantity'} + $parent_order->{'quantity'},
1650 warn "Cannot update parent order line, so do not cancel".
1655 # Recalculate tax_value
1659 tax_value_on_ordering
= quantity
* ecost_tax_excluded
* tax_rate_on_ordering
,
1660 tax_value_on_receiving
= quantity
* unitprice_tax_excluded
* tax_rate_on_receiving
1661 WHERE ordernumber
= ?
1662 |, undef, $parent_ordernumber);
1664 _cancel_items_receipt
( $order_obj, $parent_ordernumber );
1667 DELETE FROM aqorders
1668 WHERE ordernumber
= ?
1670 $sth = $dbh->prepare($query);
1671 $sth->execute($ordernumber);
1675 if( $order_obj->basket->effective_create_items eq 'ordering' ) {
1676 my @affects = split q{\|}, C4
::Context
->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1678 for my $in ( @itemnumbers ) {
1679 my $item = Koha
::Items
->find( $in );
1680 my $biblio = $item->biblio;
1681 my ( $itemfield ) = GetMarcFromKohaField
( 'items.itemnumber', $biblio->frameworkcode );
1682 my $item_marc = C4
::Items
::GetMarcItem
( $biblio->biblionumber, $in );
1683 for my $affect ( @affects ) {
1684 my ( $sf, $v ) = split q{=}, $affect, 2;
1685 foreach ( $item_marc->field($itemfield) ) {
1686 $_->update( $sf => $v );
1689 C4
::Items
::ModItemFromMarc
( $item_marc, $biblio->biblionumber, $in );
1694 return $parent_ordernumber;
1697 sub _cancel_items_receipt
{
1698 my ( $order, $parent_ordernumber ) = @_;
1699 $parent_ordernumber ||= $order->ordernumber;
1701 my @itemnumbers = GetItemnumbersFromOrder
($order->ordernumber); # FIXME Must be $order->items
1702 if ( $order->basket->effective_create_items eq 'receiving' ) {
1703 # Remove items that were created at receipt
1705 DELETE FROM items
, aqorders_items
1706 USING items
, aqorders_items
1707 WHERE items
.itemnumber
= ? AND aqorders_items
.itemnumber
= ?
1709 my $dbh = C4
::Context
->dbh;
1710 my $sth = $dbh->prepare($query);
1711 foreach my $itemnumber (@itemnumbers) {
1712 $sth->execute($itemnumber, $itemnumber);
1716 foreach my $itemnumber (@itemnumbers) {
1717 ModItemOrder
($itemnumber, $parent_ordernumber);
1722 #------------------------------------------------------------#
1726 @results = &SearchOrders({
1727 ordernumber => $ordernumber,
1730 booksellerid => $booksellerid,
1731 basketno => $basketno,
1732 basketname => $basketname,
1733 basketgroupname => $basketgroupname,
1737 biblionumber => $biblionumber,
1738 budget_id => $budget_id
1741 Searches for orders filtered by criteria.
1743 C<$ordernumber> Finds matching orders or transferred orders by ordernumber.
1744 C<$search> Finds orders matching %$search% in title, author, or isbn.
1745 C<$owner> Finds order for the logged in user.
1746 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1747 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1750 C<@results> is an array of references-to-hash with the keys are fields
1751 from aqorders, biblio, biblioitems and aqbasket tables.
1756 my ( $params ) = @_;
1757 my $ordernumber = $params->{ordernumber
};
1758 my $search = $params->{search
};
1759 my $ean = $params->{ean
};
1760 my $booksellerid = $params->{booksellerid
};
1761 my $basketno = $params->{basketno
};
1762 my $basketname = $params->{basketname
};
1763 my $basketgroupname = $params->{basketgroupname
};
1764 my $owner = $params->{owner
};
1765 my $pending = $params->{pending
};
1766 my $ordered = $params->{ordered
};
1767 my $biblionumber = $params->{biblionumber
};
1768 my $budget_id = $params->{budget_id
};
1770 my $dbh = C4
::Context
->dbh;
1773 SELECT aqbasket.basketno,
1775 borrowers.firstname,
1778 biblioitems.biblioitemnumber,
1779 biblioitems.publishercode,
1780 biblioitems.publicationyear,
1781 aqbasket.authorisedby,
1782 aqbasket.booksellerid,
1784 aqbasket.creationdate,
1785 aqbasket.basketname,
1786 aqbasketgroups.id as basketgroupid,
1787 aqbasketgroups.name as basketgroupname,
1790 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1791 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1792 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1793 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1794 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1797 # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
1799 LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1803 WHERE (datecancellationprinted is NULL)
1806 if ( $pending or $ordered ) {
1809 ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) )
1811 ( quantity > quantityreceived OR quantityreceived is NULL )
1815 $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1823 my $userenv = C4
::Context
->userenv;
1824 if ( C4
::Context
->preference("IndependentBranches") ) {
1825 unless ( C4
::Context
->IsSuperLibrarian() ) {
1828 borrowers.branchcode = ?
1829 OR borrowers.branchcode = ''
1832 push @args, $userenv->{branch
};
1836 if ( $ordernumber ) {
1837 $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1838 push @args, ( $ordernumber, $ordernumber );
1840 if ( $biblionumber ) {
1841 $query .= 'AND aqorders.biblionumber = ?';
1842 push @args, $biblionumber;
1845 $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1846 push @args, ("%$search%","%$search%","%$search%");
1849 $query .= ' AND biblioitems.ean = ?';
1852 if ( $booksellerid ) {
1853 $query .= 'AND aqbasket.booksellerid = ?';
1854 push @args, $booksellerid;
1857 $query .= 'AND aqbasket.basketno = ?';
1858 push @args, $basketno;
1861 $query .= 'AND aqbasket.basketname LIKE ?';
1862 push @args, "%$basketname%";
1864 if( $basketgroupname ) {
1865 $query .= ' AND aqbasketgroups.name LIKE ?';
1866 push @args, "%$basketgroupname%";
1870 $query .= ' AND aqbasket.authorisedby=? ';
1871 push @args, $userenv->{'number'};
1875 $query .= ' AND aqorders.budget_id = ?';
1876 push @args, $budget_id;
1879 $query .= ' ORDER BY aqbasket.basketno';
1881 my $sth = $dbh->prepare($query);
1882 $sth->execute(@args);
1883 return $sth->fetchall_arrayref({});
1886 #------------------------------------------------------------#
1890 &DelOrder($biblionumber, $ordernumber);
1892 Cancel the order with the given order and biblio numbers. It does not
1893 delete any entries in the aqorders table, it merely marks them as
1899 my ( $bibnum, $ordernumber, $delete_biblio, $reason ) = @_;
1902 my $dbh = C4
::Context
->dbh;
1905 SET datecancellationprinted=now(), orderstatus='cancelled'
1908 $query .= ", cancellationreason = ? ";
1911 WHERE biblionumber=? AND ordernumber=?
1913 my $sth = $dbh->prepare($query);
1915 $sth->execute($reason, $bibnum, $ordernumber);
1917 $sth->execute( $bibnum, $ordernumber );
1921 my @itemnumbers = GetItemnumbersFromOrder
( $ordernumber );
1922 foreach my $itemnumber (@itemnumbers){
1923 my $delcheck = C4
::Items
::DelItemCheck
( $bibnum, $itemnumber );
1925 if($delcheck != 1) {
1926 $error->{'delitem'} = 1;
1930 if($delete_biblio) {
1931 # We get the number of remaining items
1932 my $biblio = Koha
::Biblios
->find( $bibnum );
1933 my $itemcount = $biblio->items->count;
1935 # If there are no items left,
1936 if ( $itemcount == 0 ) {
1937 # We delete the record
1938 my $delcheck = DelBiblio
($bibnum);
1941 $error->{'delbiblio'} = 1;
1949 =head3 TransferOrder
1951 my $newordernumber = TransferOrder($ordernumber, $basketno);
1953 Transfer an order line to a basket.
1954 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1955 to BOOKSELLER on DATE' and create new order with internal note
1956 'Transferred from BOOKSELLER on DATE'.
1957 Move all attached items to the new order.
1958 Received orders cannot be transferred.
1959 Return the ordernumber of created order.
1964 my ($ordernumber, $basketno) = @_;
1966 return unless ($ordernumber and $basketno);
1968 my $order = Koha
::Acquisition
::Orders
->find( $ordernumber ) or return;
1969 return if $order->datereceived;
1971 $order = $order->unblessed;
1973 my $basket = GetBasket
($basketno);
1974 return unless $basket;
1976 my $dbh = C4
::Context
->dbh;
1977 my ($query, $sth, $rv);
1981 SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1982 WHERE ordernumber = ?
1984 $sth = $dbh->prepare($query);
1985 $rv = $sth->execute('cancelled', $ordernumber);
1987 delete $order->{'ordernumber'};
1988 delete $order->{parent_ordernumber
};
1989 $order->{'basketno'} = $basketno;
1991 my $newordernumber = Koha
::Acquisition
::Order
->new($order)->store->ordernumber;
1994 UPDATE aqorders_items
1996 WHERE ordernumber = ?
1998 $sth = $dbh->prepare($query);
1999 $sth->execute($newordernumber, $ordernumber);
2002 INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
2005 $sth = $dbh->prepare($query);
2006 $sth->execute($ordernumber, $newordernumber);
2008 return $newordernumber;
2011 =head2 FUNCTIONS ABOUT PARCELS
2015 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
2017 get a lists of parcels.
2024 is the bookseller this function has to get parcels.
2027 To know on what criteria the results list has to be ordered.
2030 is the booksellerinvoicenumber.
2032 =item $datefrom & $dateto
2033 to know on what date this function has to filter its search.
2038 a pointer on a hash list containing parcel informations as such :
2044 =item Last operation
2046 =item Number of biblio
2048 =item Number of items
2055 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
2056 my $dbh = C4
::Context
->dbh;
2057 my @query_params = ();
2059 SELECT aqinvoices.invoicenumber,
2060 datereceived,purchaseordernumber,
2061 count(DISTINCT biblionumber) AS biblio,
2062 sum(quantity) AS itemsexpected,
2063 sum(quantityreceived) AS itemsreceived
2064 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
2065 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2066 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
2068 push @query_params, $bookseller;
2070 if ( defined $code ) {
2071 $strsth .= ' and aqinvoices.invoicenumber like ? ';
2072 # add a % to the end of the code to allow stemming.
2073 push @query_params, "$code%";
2076 if ( defined $datefrom ) {
2077 $strsth .= ' and datereceived >= ? ';
2078 push @query_params, $datefrom;
2081 if ( defined $dateto ) {
2082 $strsth .= 'and datereceived <= ? ';
2083 push @query_params, $dateto;
2086 $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
2088 # can't use a placeholder to place this column name.
2089 # but, we could probably be checking to make sure it is a column that will be fetched.
2090 $strsth .= "order by $order " if ($order);
2092 my $sth = $dbh->prepare($strsth);
2094 $sth->execute( @query_params );
2095 my $results = $sth->fetchall_arrayref({});
2099 #------------------------------------------------------------#
2101 =head3 GetLateOrders
2103 @results = &GetLateOrders;
2105 Searches for bookseller with late orders.
2108 the table of supplier with late issues. This table is full of hashref.
2114 my $supplierid = shift;
2116 my $estimateddeliverydatefrom = shift;
2117 my $estimateddeliverydateto = shift;
2119 my $dbh = C4
::Context
->dbh;
2121 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
2122 my $dbdriver = C4
::Context
->config("db_scheme") || "mysql";
2124 my @query_params = ();
2126 SELECT aqbasket.basketno,
2127 aqorders.ordernumber,
2128 DATE(aqbasket.closedate) AS orderdate,
2129 aqbasket.basketname AS basketname,
2130 aqbasket.basketgroupid AS basketgroupid,
2131 aqbasketgroups.name AS basketgroupname,
2132 aqorders.rrp AS unitpricesupplier,
2133 aqorders.ecost AS unitpricelib,
2134 aqorders.claims_count AS claims_count,
2135 aqorders.claimed_date AS claimed_date,
2136 aqbudgets.budget_name AS budget,
2137 borrowers.branchcode AS branch,
2138 aqbooksellers.name AS supplier,
2139 aqbooksellers.id AS supplierid,
2140 biblio.author, biblio.title,
2141 biblioitems.publishercode AS publisher,
2142 biblioitems.publicationyear,
2143 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
2147 aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
2148 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
2149 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
2150 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
2151 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
2152 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2153 WHERE aqorders.basketno = aqbasket.basketno
2154 AND ( datereceived = ''
2155 OR datereceived IS NULL
2156 OR aqorders.quantityreceived < aqorders.quantity
2158 AND aqbasket.closedate IS NOT NULL
2159 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
2161 if ($dbdriver eq "mysql") {
2163 aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity,
2164 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
2165 DATEDIFF(CAST(now() AS date),closedate) AS latesince
2167 if ( defined $delay ) {
2168 $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
2169 push @query_params, $delay;
2171 $from .= " AND aqorders.quantity - COALESCE(aqorders.quantityreceived,0) <> 0";
2173 # FIXME: account for IFNULL as above
2175 aqorders.quantity AS quantity,
2176 aqorders.quantity * aqorders.rrp AS subtotal,
2177 (CAST(now() AS date) - closedate) AS latesince
2179 if ( defined $delay ) {
2180 $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
2181 push @query_params, $delay;
2183 $from .= " AND aqorders.quantity <> 0";
2185 if (defined $supplierid) {
2186 $from .= ' AND aqbasket.booksellerid = ? ';
2187 push @query_params, $supplierid;
2189 if (defined $branch) {
2190 $from .= ' AND borrowers.branchcode LIKE ? ';
2191 push @query_params, $branch;
2194 if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
2195 $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
2197 if ( defined $estimateddeliverydatefrom ) {
2198 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
2199 push @query_params, $estimateddeliverydatefrom;
2201 if ( defined $estimateddeliverydateto ) {
2202 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
2203 push @query_params, $estimateddeliverydateto;
2205 if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
2206 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
2208 if (C4
::Context
->preference("IndependentBranches")
2209 && !C4
::Context
->IsSuperLibrarian() ) {
2210 $from .= ' AND borrowers.branchcode LIKE ? ';
2211 push @query_params, C4
::Context
->userenv->{branch
};
2213 $from .= " AND orderstatus <> 'cancelled' ";
2214 my $query = "$select $from \nORDER BY latesince, basketno, borrowers.branchcode, supplier";
2215 $debug and print STDERR
"GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
2216 my $sth = $dbh->prepare($query);
2217 $sth->execute(@query_params);
2219 while (my $data = $sth->fetchrow_hashref) {
2220 push @results, $data;
2225 #------------------------------------------------------------#
2229 \@order_loop = GetHistory( %params );
2231 Retreives some acquisition history information
2241 basket - search both basket name and number
2242 booksellerinvoicenumber
2245 orderstatus (note that orderstatus '' will retrieve orders
2246 of any status except cancelled)
2248 get_canceled_order (if set to a true value, cancelled orders will
2252 $order_loop is a list of hashrefs that each look like this:
2254 'author' => 'Twain, Mark',
2256 'biblionumber' => '215',
2258 'creationdate' => 'MM/DD/YYYY',
2259 'datereceived' => undef,
2262 'invoicenumber' => undef,
2264 'ordernumber' => '1',
2266 'quantityreceived' => undef,
2267 'title' => 'The Adventures of Huckleberry Finn'
2273 # don't run the query if there are no parameters (list would be too long for sure !)
2274 croak
"No search params" unless @_;
2276 my $title = $params{title
};
2277 my $author = $params{author
};
2278 my $isbn = $params{isbn
};
2279 my $ean = $params{ean
};
2280 my $name = $params{name
};
2281 my $from_placed_on = $params{from_placed_on
};
2282 my $to_placed_on = $params{to_placed_on
};
2283 my $basket = $params{basket
};
2284 my $booksellerinvoicenumber = $params{booksellerinvoicenumber
};
2285 my $basketgroupname = $params{basketgroupname
};
2286 my $budget = $params{budget
};
2287 my $orderstatus = $params{orderstatus
};
2288 my $biblionumber = $params{biblionumber
};
2289 my $get_canceled_order = $params{get_canceled_order
} || 0;
2290 my $ordernumber = $params{ordernumber
};
2291 my $search_children_too = $params{search_children_too
} || 0;
2292 my $created_by = $params{created_by
} || [];
2296 my $total_qtyreceived = 0;
2297 my $total_price = 0;
2299 #get variation of isbn
2303 if ( C4
::Context
->preference("SearchWithISBNVariations") ){
2304 @isbns = C4
::Koha
::GetVariationsOfISBN
( $isbn );
2305 foreach my $isb (@isbns){
2306 push @isbn_params, '?';
2311 push @isbn_params, '?';
2315 my $dbh = C4
::Context
->dbh;
2318 COALESCE(biblio.title, deletedbiblio.title) AS title,
2319 COALESCE(biblio.author, deletedbiblio.author) AS author,
2320 COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2321 COALESCE(biblioitems.ean, deletedbiblioitems.ean) AS ean,
2323 aqbasket.basketname,
2324 aqbasket.basketgroupid,
2325 aqbasket.authorisedby,
2326 concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2327 aqbasketgroups.name as groupname,
2329 aqbasket.creationdate,
2330 aqorders.datereceived,
2332 aqorders.quantityreceived,
2334 aqorders.ordernumber,
2336 aqinvoices.invoicenumber,
2337 aqbooksellers.id as id,
2338 aqorders.biblionumber,
2339 aqorders.orderstatus,
2340 aqorders.parent_ordernumber,
2341 aqbudgets.budget_name
2343 $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2346 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2347 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2348 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2349 LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2350 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2351 LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2352 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2353 LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2354 LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2355 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2358 $query .= " WHERE 1 ";
2360 unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2361 $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2364 my @query_params = ();
2366 if ( $biblionumber ) {
2367 $query .= " AND biblio.biblionumber = ?";
2368 push @query_params, $biblionumber;
2372 $query .= " AND biblio.title LIKE ? ";
2373 $title =~ s/\s+/%/g;
2374 push @query_params, "%$title%";
2378 $query .= " AND biblio.author LIKE ? ";
2379 push @query_params, "%$author%";
2383 $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2384 foreach my $isb (@isbns){
2385 push @query_params, "%$isb%";
2390 $query .= " AND biblioitems.ean = ? ";
2391 push @query_params, "$ean";
2394 $query .= " AND aqbooksellers.name LIKE ? ";
2395 push @query_params, "%$name%";
2399 $query .= " AND aqbudgets.budget_id = ? ";
2400 push @query_params, "$budget";
2403 if ( $from_placed_on ) {
2404 $query .= " AND creationdate >= ? ";
2405 push @query_params, $from_placed_on;
2408 if ( $to_placed_on ) {
2409 $query .= " AND creationdate <= ? ";
2410 push @query_params, $to_placed_on;
2413 if ( defined $orderstatus and $orderstatus ne '') {
2414 $query .= " AND aqorders.orderstatus = ? ";
2415 push @query_params, "$orderstatus";
2419 if ($basket =~ m/^\d+$/) {
2420 $query .= " AND aqorders.basketno = ? ";
2421 push @query_params, $basket;
2423 $query .= " AND aqbasket.basketname LIKE ? ";
2424 push @query_params, "%$basket%";
2428 if ($booksellerinvoicenumber) {
2429 $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2430 push @query_params, "%$booksellerinvoicenumber%";
2433 if ($basketgroupname) {
2434 $query .= " AND aqbasketgroups.name LIKE ? ";
2435 push @query_params, "%$basketgroupname%";
2439 $query .= " AND (aqorders.ordernumber = ? ";
2440 push @query_params, $ordernumber;
2441 if ($search_children_too) {
2442 $query .= " OR aqorders.parent_ordernumber = ? ";
2443 push @query_params, $ordernumber;
2448 if ( @
$created_by ) {
2449 $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @
$created_by ) . ')';
2450 push @query_params, @
$created_by;
2454 if ( C4
::Context
->preference("IndependentBranches") ) {
2455 unless ( C4
::Context
->IsSuperLibrarian() ) {
2456 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2457 push @query_params, C4
::Context
->userenv->{branch
};
2460 $query .= " ORDER BY id";
2462 return $dbh->selectall_arrayref( $query, { Slice
=> {} }, @query_params );
2465 =head2 GetRecentAcqui
2467 $results = GetRecentAcqui($days);
2469 C<$results> is a ref to a table which contains hashref
2473 sub GetRecentAcqui
{
2475 my $dbh = C4
::Context
->dbh;
2479 ORDER BY timestamp DESC
2482 my $sth = $dbh->prepare($query);
2484 my $results = $sth->fetchall_arrayref({});
2488 #------------------------------------------------------------#
2492 &AddClaim($ordernumber);
2494 Add a claim for an order
2499 my ($ordernumber) = @_;
2500 my $dbh = C4
::Context
->dbh;
2503 claims_count = claims_count + 1,
2504 claimed_date = CURDATE()
2505 WHERE ordernumber = ?
2507 my $sth = $dbh->prepare($query);
2508 $sth->execute($ordernumber);
2513 my @invoices = GetInvoices(
2514 invoicenumber => $invoicenumber,
2515 supplierid => $supplierid,
2516 suppliername => $suppliername,
2517 shipmentdatefrom => $shipmentdatefrom, # ISO format
2518 shipmentdateto => $shipmentdateto, # ISO format
2519 billingdatefrom => $billingdatefrom, # ISO format
2520 billingdateto => $billingdateto, # ISO format
2521 isbneanissn => $isbn_or_ean_or_issn,
2524 publisher => $publisher,
2525 publicationyear => $publicationyear,
2526 branchcode => $branchcode,
2527 order_by => $order_by
2530 Return a list of invoices that match all given criteria.
2532 $order_by is "column_name (asc|desc)", where column_name is any of
2533 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2534 'shipmentcost', 'shipmentcost_budgetid'.
2536 asc is the default if omitted
2543 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2544 closedate shipmentcost shipmentcost_budgetid);
2546 my $dbh = C4
::Context
->dbh;
2548 SELECT aqinvoices
.invoiceid
, aqinvoices
.invoicenumber
, aqinvoices
.booksellerid
, aqinvoices
.shipmentdate
, aqinvoices
.billingdate
, aqinvoices
.closedate
, aqinvoices
.shipmentcost
, aqinvoices
.shipmentcost_budgetid
, aqinvoices
.message_id
,
2549 aqbooksellers
.name AS suppliername
,
2552 aqorders
.datereceived IS NOT NULL
,
2553 aqorders
.biblionumber
,
2556 ) AS receivedbiblios
,
2559 aqorders
.subscriptionid IS NOT NULL
,
2560 aqorders
.subscriptionid
,
2563 ) AS is_linked_to_subscriptions
,
2564 SUM
(aqorders
.quantityreceived
) AS receiveditems
2566 LEFT JOIN aqbooksellers ON aqbooksellers
.id
= aqinvoices
.booksellerid
2567 LEFT JOIN aqorders ON aqorders
.invoiceid
= aqinvoices
.invoiceid
2568 LEFT JOIN aqbasket ON aqbasket
.basketno
=aqorders
.basketno
2569 LEFT JOIN borrowers ON aqbasket
.authorisedby
=borrowers
.borrowernumber
2570 LEFT JOIN biblio ON aqorders
.biblionumber
= biblio
.biblionumber
2571 LEFT JOIN biblioitems ON biblio
.biblionumber
= biblioitems
.biblionumber
2572 LEFT JOIN subscription ON biblio
.biblionumber
= subscription
.biblionumber
2577 if($args{supplierid
}) {
2578 push @bind_strs, " aqinvoices.booksellerid = ? ";
2579 push @bind_args, $args{supplierid
};
2581 if($args{invoicenumber
}) {
2582 push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2583 push @bind_args, "%$args{invoicenumber}%";
2585 if($args{suppliername
}) {
2586 push @bind_strs, " aqbooksellers.name LIKE ? ";
2587 push @bind_args, "%$args{suppliername}%";
2589 if($args{shipmentdatefrom
}) {
2590 push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2591 push @bind_args, $args{shipmentdatefrom
};
2593 if($args{shipmentdateto
}) {
2594 push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2595 push @bind_args, $args{shipmentdateto
};
2597 if($args{billingdatefrom
}) {
2598 push @bind_strs, " aqinvoices.billingdate >= ? ";
2599 push @bind_args, $args{billingdatefrom
};
2601 if($args{billingdateto
}) {
2602 push @bind_strs, " aqinvoices.billingdate <= ? ";
2603 push @bind_args, $args{billingdateto
};
2605 if($args{isbneanissn
}) {
2606 push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2607 push @bind_args, $args{isbneanissn
}, $args{isbneanissn
}, $args{isbneanissn
};
2610 push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2611 push @bind_args, $args{title
};
2614 push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2615 push @bind_args, $args{author
};
2617 if($args{publisher
}) {
2618 push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2619 push @bind_args, $args{publisher
};
2621 if($args{publicationyear
}) {
2622 push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2623 push @bind_args, $args{publicationyear
}, $args{publicationyear
};
2625 if($args{branchcode
}) {
2626 push @bind_strs, " borrowers.branchcode = ? ";
2627 push @bind_args, $args{branchcode
};
2629 if($args{message_id
}) {
2630 push @bind_strs, " aqinvoices.message_id = ? ";
2631 push @bind_args, $args{message_id
};
2634 $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2635 $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";
2637 if($args{order_by
}) {
2638 my ($column, $direction) = split / /, $args{order_by
};
2639 if(grep /^$column$/, @columns) {
2640 $direction ||= 'ASC';
2641 $query .= " ORDER BY $column $direction";
2645 my $sth = $dbh->prepare($query);
2646 $sth->execute(@bind_args);
2648 my $results = $sth->fetchall_arrayref({});
2654 my $invoice = GetInvoice($invoiceid);
2656 Get informations about invoice with given $invoiceid
2658 Return a hash filled with aqinvoices.* fields
2663 my ($invoiceid) = @_;
2666 return unless $invoiceid;
2668 my $dbh = C4
::Context
->dbh;
2674 my $sth = $dbh->prepare($query);
2675 $sth->execute($invoiceid);
2677 $invoice = $sth->fetchrow_hashref;
2681 =head3 GetInvoiceDetails
2683 my $invoice = GetInvoiceDetails($invoiceid)
2685 Return informations about an invoice + the list of related order lines
2687 Orders informations are in $invoice->{orders} (array ref)
2691 sub GetInvoiceDetails
{
2692 my ($invoiceid) = @_;
2694 if ( !defined $invoiceid ) {
2695 carp
'GetInvoiceDetails called without an invoiceid';
2699 my $dbh = C4
::Context
->dbh;
2701 SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2703 LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2706 my $sth = $dbh->prepare($query);
2707 $sth->execute($invoiceid);
2709 my $invoice = $sth->fetchrow_hashref;
2714 biblio.copyrightdate,
2716 biblioitems.publishercode,
2717 biblioitems.publicationyear,
2718 aqbasket.basketname,
2719 aqbasketgroups.id AS basketgroupid,
2720 aqbasketgroups.name AS basketgroupname
2722 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2723 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2724 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2725 LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2728 $sth = $dbh->prepare($query);
2729 $sth->execute($invoiceid);
2730 $invoice->{orders
} = $sth->fetchall_arrayref({});
2731 $invoice->{orders
} ||= []; # force an empty arrayref if fetchall_arrayref fails
2738 my $invoiceid = AddInvoice(
2739 invoicenumber => $invoicenumber,
2740 booksellerid => $booksellerid,
2741 shipmentdate => $shipmentdate,
2742 billingdate => $billingdate,
2743 closedate => $closedate,
2744 shipmentcost => $shipmentcost,
2745 shipmentcost_budgetid => $shipmentcost_budgetid
2748 Create a new invoice and return its id or undef if it fails.
2755 return unless(%invoice and $invoice{invoicenumber
});
2757 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2758 closedate shipmentcost shipmentcost_budgetid message_id);
2762 foreach my $key (keys %invoice) {
2763 if(0 < grep(/^$key$/, @columns)) {
2764 push @set_strs, "$key = ?";
2765 push @set_args, ($invoice{$key} || undef);
2771 my $dbh = C4
::Context
->dbh;
2772 my $query = "INSERT INTO aqinvoices SET ";
2773 $query .= join (",", @set_strs);
2774 my $sth = $dbh->prepare($query);
2775 $rv = $sth->execute(@set_args);
2777 $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2786 invoiceid => $invoiceid, # Mandatory
2787 invoicenumber => $invoicenumber,
2788 booksellerid => $booksellerid,
2789 shipmentdate => $shipmentdate,
2790 billingdate => $billingdate,
2791 closedate => $closedate,
2792 shipmentcost => $shipmentcost,
2793 shipmentcost_budgetid => $shipmentcost_budgetid
2796 Modify an invoice, invoiceid is mandatory.
2798 Return undef if it fails.
2805 return unless(%invoice and $invoice{invoiceid
});
2807 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2808 closedate shipmentcost shipmentcost_budgetid);
2812 foreach my $key (keys %invoice) {
2813 if(0 < grep(/^$key$/, @columns)) {
2814 push @set_strs, "$key = ?";
2815 push @set_args, ($invoice{$key} || undef);
2819 my $dbh = C4
::Context
->dbh;
2820 my $query = "UPDATE aqinvoices SET ";
2821 $query .= join(",", @set_strs);
2822 $query .= " WHERE invoiceid = ?";
2824 my $sth = $dbh->prepare($query);
2825 $sth->execute(@set_args, $invoice{invoiceid
});
2830 CloseInvoice($invoiceid);
2834 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2839 my ($invoiceid) = @_;
2841 return unless $invoiceid;
2843 my $dbh = C4
::Context
->dbh;
2846 SET closedate
= CAST
(NOW
() AS DATE
)
2849 my $sth = $dbh->prepare($query);
2850 $sth->execute($invoiceid);
2853 =head3 ReopenInvoice
2855 ReopenInvoice($invoiceid);
2859 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2864 my ($invoiceid) = @_;
2866 return unless $invoiceid;
2868 my $dbh = C4
::Context
->dbh;
2871 SET closedate
= NULL
2874 my $sth = $dbh->prepare($query);
2875 $sth->execute($invoiceid);
2880 DelInvoice($invoiceid);
2882 Delete an invoice if there are no items attached to it.
2887 my ($invoiceid) = @_;
2889 return unless $invoiceid;
2891 my $dbh = C4
::Context
->dbh;
2897 my $sth = $dbh->prepare($query);
2898 $sth->execute($invoiceid);
2899 my $res = $sth->fetchrow_arrayref;
2900 if ( $res && $res->[0] == 0 ) {
2902 DELETE FROM aqinvoices
2905 my $sth = $dbh->prepare($query);
2906 return ( $sth->execute($invoiceid) > 0 );
2911 =head3 MergeInvoices
2913 MergeInvoices($invoiceid, \@sourceids);
2915 Merge the invoices identified by the IDs in \@sourceids into
2916 the invoice identified by $invoiceid.
2921 my ($invoiceid, $sourceids) = @_;
2923 return unless $invoiceid;
2924 foreach my $sourceid (@
$sourceids) {
2925 next if $sourceid == $invoiceid;
2926 my $source = GetInvoiceDetails
($sourceid);
2927 foreach my $order (@
{$source->{'orders'}}) {
2928 $order->{'invoiceid'} = $invoiceid;
2931 DelInvoice
($source->{'invoiceid'});
2936 =head3 GetBiblioCountByBasketno
2938 $biblio_count = &GetBiblioCountByBasketno($basketno);
2940 Looks up the biblio's count that has basketno value $basketno
2946 sub GetBiblioCountByBasketno
{
2947 my ($basketno) = @_;
2948 my $dbh = C4
::Context
->dbh;
2950 SELECT COUNT( DISTINCT( biblionumber ) )
2953 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
2956 my $sth = $dbh->prepare($query);
2957 $sth->execute($basketno);
2958 return $sth->fetchrow;
2961 # Note this subroutine should be moved to Koha::Acquisition::Order
2962 # Will do when a DBIC decision will be taken.
2963 sub populate_order_with_prices
{
2966 my $order = $params->{order
};
2967 my $booksellerid = $params->{booksellerid
};
2968 return unless $booksellerid;
2970 my $bookseller = Koha
::Acquisition
::Booksellers
->find( $booksellerid );
2972 my $receiving = $params->{receiving
};
2973 my $ordering = $params->{ordering
};
2974 my $discount = $order->{discount
};
2975 $discount /= 100 if $discount > 1;
2978 $order->{tax_rate_on_ordering
} //= $order->{tax_rate
};
2979 if ( $bookseller->listincgst ) {
2980 # The user entered the rrp tax included
2981 $order->{rrp_tax_included
} = $order->{rrp
};
2983 # rrp tax excluded = rrp tax included / ( 1 + tax rate )
2984 $order->{rrp_tax_excluded
} = $order->{rrp_tax_included
} / ( 1 + $order->{tax_rate_on_ordering
} );
2986 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2987 $order->{ecost_tax_excluded
} = $order->{rrp_tax_excluded
} * ( 1 - $discount );
2989 # ecost tax included = rrp tax included ( 1 - discount )
2990 $order->{ecost_tax_included
} = $order->{rrp_tax_included
} * ( 1 - $discount );
2993 # The user entered the rrp tax excluded
2994 $order->{rrp_tax_excluded
} = $order->{rrp
};
2996 # rrp tax included = rrp tax excluded * ( 1 - tax rate )
2997 $order->{rrp_tax_included
} = $order->{rrp_tax_excluded
} * ( 1 + $order->{tax_rate_on_ordering
} );
2999 # ecost tax excluded = rrp tax excluded * ( 1 - discount )
3000 $order->{ecost_tax_excluded
} = $order->{rrp_tax_excluded
} * ( 1 - $discount );
3002 # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount )
3003 $order->{ecost_tax_included
} =
3004 $order->{rrp_tax_excluded
} *
3005 ( 1 + $order->{tax_rate_on_ordering
} ) *
3009 # tax value = quantity * ecost tax excluded * tax rate
3010 $order->{tax_value_on_ordering
} =
3011 $order->{quantity
} * $order->{ecost_tax_excluded
} * $order->{tax_rate_on_ordering
};
3015 $order->{tax_rate_on_receiving
} //= $order->{tax_rate
};
3016 if ( $bookseller->invoiceincgst ) {
3017 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3018 # we need to keep the exact ecost value
3019 if ( Koha
::Number
::Price
->new( $order->{unitprice
} )->round == Koha
::Number
::Price
->new( $order->{ecost_tax_included
} )->round ) {
3020 $order->{unitprice
} = $order->{ecost_tax_included
};
3023 # The user entered the unit price tax included
3024 $order->{unitprice_tax_included
} = $order->{unitprice
};
3026 # unit price tax excluded = unit price tax included / ( 1 + tax rate )
3027 $order->{unitprice_tax_excluded
} = $order->{unitprice_tax_included
} / ( 1 + $order->{tax_rate_on_receiving
} );
3030 # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3031 # we need to keep the exact ecost value
3032 if ( Koha
::Number
::Price
->new( $order->{unitprice
} )->round == Koha
::Number
::Price
->new( $order->{ecost_tax_excluded
} )->round ) {
3033 $order->{unitprice
} = $order->{ecost_tax_excluded
};
3036 # The user entered the unit price tax excluded
3037 $order->{unitprice_tax_excluded
} = $order->{unitprice
};
3040 # unit price tax included = unit price tax included * ( 1 + tax rate )
3041 $order->{unitprice_tax_included
} = $order->{unitprice_tax_excluded
} * ( 1 + $order->{tax_rate_on_receiving
} );
3044 # tax value = quantity * unit price tax excluded * tax rate
3045 $order->{tax_value_on_receiving
} = $order->{quantity
} * $order->{unitprice_tax_excluded
} * $order->{tax_rate_on_receiving
};
3051 =head3 GetOrderUsers
3053 $order_users_ids = &GetOrderUsers($ordernumber);
3055 Returns a list of all borrowernumbers that are in order users list
3060 my ($ordernumber) = @_;
3062 return unless $ordernumber;
3065 SELECT borrowernumber
3067 WHERE ordernumber
= ?
3069 my $dbh = C4
::Context
->dbh;
3070 my $sth = $dbh->prepare($query);
3071 $sth->execute($ordernumber);
3072 my $results = $sth->fetchall_arrayref( {} );
3074 my @borrowernumbers;
3075 foreach (@
$results) {
3076 push @borrowernumbers, $_->{'borrowernumber'};
3079 return @borrowernumbers;
3082 =head3 ModOrderUsers
3084 my @order_users_ids = (1, 2, 3);
3085 &ModOrderUsers($ordernumber, @basketusers_ids);
3087 Delete all users from order users list, and add users in C<@order_users_ids>
3093 my ( $ordernumber, @order_users_ids ) = @_;
3095 return unless $ordernumber;
3097 my $dbh = C4
::Context
->dbh;
3099 DELETE FROM aqorder_users
3100 WHERE ordernumber
= ?
3102 my $sth = $dbh->prepare($query);
3103 $sth->execute($ordernumber);
3106 INSERT INTO aqorder_users
(ordernumber
, borrowernumber
)
3109 $sth = $dbh->prepare($query);
3110 foreach my $order_user_id (@order_users_ids) {
3111 $sth->execute( $ordernumber, $order_user_id );
3115 sub NotifyOrderUsers
{
3116 my ($ordernumber) = @_;
3118 my @borrowernumbers = GetOrderUsers
($ordernumber);
3119 return unless @borrowernumbers;
3121 my $order = GetOrder
( $ordernumber );
3122 for my $borrowernumber (@borrowernumbers) {
3123 my $patron = Koha
::Patrons
->find( $borrowernumber );
3124 my $library = $patron->library->unblessed;
3125 my $biblio = Koha
::Biblios
->find( $order->{biblionumber
} )->unblessed;
3126 my $letter = C4
::Letters
::GetPreparedLetter
(
3127 module
=> 'acquisition',
3128 letter_code
=> 'ACQ_NOTIF_ON_RECEIV',
3129 branchcode
=> $library->{branchcode
},
3130 lang
=> $patron->lang,
3132 'branches' => $library,
3133 'borrowers' => $patron->unblessed,
3134 'biblio' => $biblio,
3135 'aqorders' => $order,
3139 C4
::Letters
::EnqueueLetter
(
3142 borrowernumber
=> $borrowernumber,
3143 LibraryName
=> C4
::Context
->preference("LibraryName"),
3144 message_transport_type
=> 'email',
3146 ) or warn "can't enqueue letter $letter";
3151 =head3 FillWithDefaultValues
3153 FillWithDefaultValues( $marc_record );
3155 This will update the record with default value defined in the ACQ framework.
3156 For all existing fields, if a default value exists and there are no subfield, it will be created.
3157 If the field does not exist, it will be created too.
3161 sub FillWithDefaultValues
{
3163 my $tagslib = C4
::Biblio
::GetMarcStructure
( 1, 'ACQ', { unsafe
=> 1 } );
3166 C4
::Biblio
::GetMarcFromKohaField
( 'items.itemnumber', '' );
3167 for my $tag ( sort keys %$tagslib ) {
3169 next if $tag == $itemfield;
3170 for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3171 next if IsMarcStructureInternal
($tagslib->{$tag}{$subfield});
3172 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue
};
3173 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3174 my @fields = $record->field($tag);
3176 for my $field (@fields) {
3177 unless ( defined $field->subfield($subfield) ) {
3178 $field->add_subfields(
3179 $subfield => $defaultvalue );
3184 $record->insert_fields_ordered(
3186 $tag, '', '', $subfield => $defaultvalue
3201 Koha Development Team <http://koha-community.org/>