Main Koha release repository https://koha-community.org
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

3306 lines
103 KiB

package C4::Acquisition;
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.
use Modern::Perl;
use Carp;
use C4::Context;
use C4::Debug;
use C4::Suggestions;
use C4::Biblio;
use C4::Contract;
use C4::Debug;
use C4::Templates qw(gettemplate);
use Koha::DateUtils qw( dt_from_string output_pref );
use Koha::Acquisition::Baskets;
use Koha::Acquisition::Booksellers;
use Koha::Acquisition::Orders;
use Koha::Biblios;
use Koha::Exceptions;
use Koha::Items;
use Koha::Number::Price;
use Koha::Libraries;
use Koha::CsvProfiles;
use Koha::Patrons;
use C4::Koha;
use MARC::Field;
use MARC::Record;
use Time::localtime;
use vars qw(@ISA @EXPORT);
BEGIN {
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(
&GetBasket &NewBasket &CloseBasket &ReopenBasket &DelBasket &ModBasket
&GetBasketAsCSV &GetBasketGroupAsCSV
&GetBasketsByBookseller &GetBasketsByBasketgroup
&GetBasketsInfosByBookseller
&GetBasketUsers &ModBasketUsers
&CanUserManageBasket
&ModBasketHeader
&ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup
&GetBasketgroups &ReOpenBasketgroup
&DelOrder &ModOrder &GetOrder &GetOrders &GetOrdersByBiblionumber
&GetLateOrders &GetOrderFromItemnumber
&SearchOrders &GetHistory &GetRecentAcqui
&ModReceiveOrder &CancelReceipt
&TransferOrder
&GetLastOrderNotReceivedFromSubscriptionid &GetLastOrderReceivedFromSubscriptionid
&ModItemOrder
&GetParcels
&GetInvoices
&GetInvoice
&GetInvoiceDetails
&AddInvoice
&ModInvoice
&CloseInvoice
&ReopenInvoice
&DelInvoice
&MergeInvoices
&AddClaim
&GetBiblioCountByBasketno
&GetOrderUsers
&ModOrderUsers
&NotifyOrderUsers
&FillWithDefaultValues
&get_rounded_price
&get_rounding_sql
);
}
sub GetOrderFromItemnumber {
my ($itemnumber) = @_;
my $dbh = C4::Context->dbh;
my $query = qq|
SELECT * from aqorders LEFT JOIN aqorders_items
ON ( aqorders.ordernumber = aqorders_items.ordernumber )
WHERE itemnumber = ? ;
my $sth = $dbh->prepare($query);
# $sth->trace(3);
$sth->execute($itemnumber);
my $order = $sth->fetchrow_hashref;
return ( $order );
}
=head1 NAME
C4::Acquisition - Koha functions for dealing with orders and acquisitions
=head1 SYNOPSIS
use C4::Acquisition;
=head1 DESCRIPTION
The functions in this module deal with acquisitions, managing book
orders, basket and parcels.
=head1 FUNCTIONS
=head2 FUNCTIONS ABOUT BASKETS
=head3 GetBasket
$aqbasket = &GetBasket($basketnumber);
get all basket informations in aqbasket for a given basket
B<returns:> informations for a given basket returned as a hashref.
=cut
sub GetBasket {
my ($basketno) = @_;
my $dbh = C4::Context->dbh;
my $query = "
SELECT aqbasket.*,
concat( b.firstname,' ',b.surname) AS authorisedbyname
FROM aqbasket
LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
WHERE basketno=?
";
my $sth=$dbh->prepare($query);
$sth->execute($basketno);
my $basket = $sth->fetchrow_hashref;
return ( $basket );
}
#------------------------------------------------------------#
=head3 NewBasket
$basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
$basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace, $is_standing, $create_items );
Create a new basket in aqbasket table
=over
=item C<$booksellerid> is a foreign key in the aqbasket table
=item C<$authorizedby> is the username of who created the basket
=back
The other parameters are optional, see ModBasketHeader for more info on them.
=cut
sub NewBasket {
my ( $booksellerid, $authorisedby, $basketname, $basketnote,
$basketbooksellernote, $basketcontractnumber, $deliveryplace,
$billingplace, $is_standing, $create_items ) = @_;
my $dbh = C4::Context->dbh;
my $query =
'INSERT INTO aqbasket (creationdate,booksellerid,authorisedby) '
. 'VALUES (now(),?,?)';
$dbh->do( $query, {}, $booksellerid, $authorisedby );
my $basket = $dbh->{mysql_insertid};
$basketname ||= q{}; # default to empty strings
$basketnote ||= q{};
$basketbooksellernote ||= q{};
ModBasketHeader( $basket, $basketname, $basketnote, $basketbooksellernote,
$basketcontractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items );
return $basket;
}
#------------------------------------------------------------#
=head3 CloseBasket
&CloseBasket($basketno);
close a basket (becomes unmodifiable, except for receives)
=cut
sub CloseBasket {
my ($basketno) = @_;
my $dbh = C4::Context->dbh;
$dbh->do('UPDATE aqbasket SET closedate=now() WHERE basketno=?', {}, $basketno );
$dbh->do(
q{UPDATE aqorders SET orderstatus = 'ordered' WHERE basketno = ? AND orderstatus NOT IN ( 'complete', 'cancelled')},
{}, $basketno
);
return;
}
=head3 ReopenBasket
&ReopenBasket($basketno);
reopen a basket
=cut
sub ReopenBasket {
my ($basketno) = @_;
my $dbh = C4::Context->dbh;
$dbh->do( q{UPDATE aqbasket SET closedate=NULL WHERE basketno=?}, {}, $basketno );
$dbh->do( q{
UPDATE aqorders
SET orderstatus = 'new'
WHERE basketno = ?
AND orderstatus NOT IN ( 'complete', 'cancelled' )
}, {}, $basketno);
return;
}
#------------------------------------------------------------#
=head3 GetBasketAsCSV
&GetBasketAsCSV($basketno);
Export a basket as CSV
$cgi parameter is needed for column name translation
=cut
sub GetBasketAsCSV {
my ($basketno, $cgi, $csv_profile_id) = @_;
my $basket = GetBasket($basketno);
my @orders = GetOrders($basketno);
my $contract = GetContract({
contractnumber => $basket->{'contractnumber'}
});
my $template = C4::Templates::gettemplate("acqui/csv/basket.tt", "intranet", $cgi);
my @rows;
if ($csv_profile_id) {
my $csv_profile = Koha::CsvProfiles->find( $csv_profile_id );
Koha::Exceptions::ObjectNotFound->throw( 'There is no valid csv profile given') unless $csv_profile;
my $csv = Text::CSV_XS->new({'quote_char'=>'"','escape_char'=>'"','sep_char'=>$csv_profile->csv_separator,'binary'=>1});
my $csv_profile_content = $csv_profile->content;
my ( @headers, @fields );
while ( $csv_profile_content =~ /
([^=\|]+) # header
=?
([^\|]*) # fieldname (table.row or row)
\|? /gxms
) {
my $header = $1;
my $field = ($2 eq '') ? $1 : $2;
$header =~ s/^\s+|\s+$//g; # Trim whitespaces
push @headers, $header;
$field =~ s/[^\.]*\.{1}//; # Remove the table name if exists.
$field =~ s/^\s+|\s+$//g; # Trim whitespaces
push @fields, $field;
}
for my $order (@orders) {
my @row;
my $biblio = Koha::Biblios->find( $order->{biblionumber} );
my $biblioitem = $biblio->biblioitem;
$order = { %$order, %{ $biblioitem->unblessed } };
if ($contract) {
$order = {%$order, %$contract};
}
$order = {%$order, %$basket, %{ $biblio->unblessed }};
for my $field (@fields) {
push @row, $order->{$field};
}
push @rows, \@row;
}
my $content = join( $csv_profile->csv_separator, @headers ) . "\n";
for my $row ( @rows ) {
$csv->combine(@$row);
my $string = $csv->string;
$content .= $string . "\n";
}
return $content;
}
else {
foreach my $order (@orders) {
my $biblio = Koha::Biblios->find( $order->{biblionumber} );
my $biblioitem = $biblio->biblioitem;
my $row = {
contractname => $contract->{'contractname'},
ordernumber => $order->{'ordernumber'},
entrydate => $order->{'entrydate'},
isbn => $order->{'isbn'},
author => $biblio->author,
title => $biblio->title,
publicationyear => $biblioitem->publicationyear,
publishercode => $biblioitem->publishercode,
collectiontitle => $biblioitem->collectiontitle,
notes => $order->{'order_vendornote'},
quantity => $order->{'quantity'},
rrp => $order->{'rrp'},
};
for my $place ( qw( deliveryplace billingplace ) ) {
if ( my $library = Koha::Libraries->find( $row->{deliveryplace} ) ) {
$row->{$place} = $library->branchname
}
}
foreach(qw(
contractname author title publishercode collectiontitle notes
deliveryplace billingplace
) ) {
# Double the quotes to not be interpreted as a field end
$row->{$_} =~ s/"/""/g if $row->{$_};
}
push @rows, $row;
}
@rows = sort {
if(defined $a->{publishercode} and defined $b->{publishercode}) {
$a->{publishercode} cmp $b->{publishercode};
}
} @rows;
$template->param(rows => \@rows);
return $template->output;
}
}
=head3 GetBasketGroupAsCSV
&GetBasketGroupAsCSV($basketgroupid);
Export a basket group as CSV
$cgi parameter is needed for column name translation
=cut
sub GetBasketGroupAsCSV {
my ($basketgroupid, $cgi) = @_;
my $baskets = GetBasketsByBasketgroup($basketgroupid);
my $template = C4::Templates::gettemplate('acqui/csv/basketgroup.tt', 'intranet', $cgi);
my @rows;
for my $basket (@$baskets) {
my @orders = GetOrders( $basket->{basketno} );
my $contract = GetContract({
contractnumber => $basket->{contractnumber}
});
my $bookseller = Koha::Acquisition::Booksellers->find( $basket->{booksellerid} );
my $basketgroup = GetBasketgroup( $$basket{basketgroupid} );
foreach my $order (@orders) {
my $biblio = Koha::Biblios->find( $order->{biblionumber} );
my $biblioitem = $biblio->biblioitem;
my $row = {
clientnumber => $bookseller->accountnumber,
basketname => $basket->{basketname},
ordernumber => $order->{ordernumber},
author => $biblio->author,
title => $biblio->title,
publishercode => $biblioitem->publishercode,
publicationyear => $biblioitem->publicationyear,
collectiontitle => $biblioitem->collectiontitle,
isbn => $order->{isbn},
quantity => $order->{quantity},
rrp_tax_included => $order->{rrp_tax_included},
rrp_tax_excluded => $order->{rrp_tax_excluded},
discount => $bookseller->discount,
ecost_tax_included => $order->{ecost_tax_included},
ecost_tax_excluded => $order->{ecost_tax_excluded},
notes => $order->{order_vendornote},
entrydate => $order->{entrydate},
booksellername => $bookseller->name,
bookselleraddress => $bookseller->address1,
booksellerpostal => $bookseller->postal,
contractnumber => $contract->{contractnumber},
contractname => $contract->{contractname},
};
my $temp = {
basketgroupdeliveryplace => $basketgroup->{deliveryplace},
basketgroupbillingplace => $basketgroup->{billingplace},
basketdeliveryplace => $basket->{deliveryplace},
basketbillingplace => $basket->{billingplace},
};
for my $place (qw( basketgroupdeliveryplace basketgroupbillingplace basketdeliveryplace basketbillingplace )) {
if ( my $library = Koha::Libraries->find( $temp->{$place} ) ) {
$row->{$place} = $library->branchname;
}
}
foreach(qw(
basketname author title publishercode collectiontitle notes
booksellername bookselleraddress booksellerpostal contractname
basketgroupdeliveryplace basketgroupbillingplace
basketdeliveryplace basketbillingplace
) ) {
# Double the quotes to not be interpreted as a field end
$row->{$_} =~ s/"/""/g if $row->{$_};
}
push @rows, $row;
}
}
$template->param(rows => \@rows);
return $template->output;
}
=head3 CloseBasketgroup
&CloseBasketgroup($basketgroupno);
close a basketgroup
=cut
sub CloseBasketgroup {
my ($basketgroupno) = @_;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("
UPDATE aqbasketgroups
SET closed=1
WHERE id=?
");
$sth->execute($basketgroupno);
}
#------------------------------------------------------------#
=head3 ReOpenBaskergroup($basketgroupno)
&ReOpenBaskergroup($basketgroupno);
reopen a basketgroup
=cut
sub ReOpenBasketgroup {
my ($basketgroupno) = @_;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("
UPDATE aqbasketgroups
SET closed=0
WHERE id=?
");
$sth->execute($basketgroupno);
}
#------------------------------------------------------------#
=head3 DelBasket
&DelBasket($basketno);
Deletes the basket that has basketno field $basketno in the aqbasket table.
=over
=item C<$basketno> is the primary key of the basket in the aqbasket table.
=back
=cut
sub DelBasket {
my ( $basketno ) = @_;
my $query = "DELETE FROM aqbasket WHERE basketno=?";
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare($query);
$sth->execute($basketno);
return;
}
#------------------------------------------------------------#
=head3 ModBasket
&ModBasket($basketinfo);
Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
=over
=item C<$basketno> is the primary key of the basket in the aqbasket table.
=back
=cut
sub ModBasket {
my $basketinfo = shift;
my $query = "UPDATE aqbasket SET ";
my @params;
foreach my $key (keys %$basketinfo){
if ($key ne 'basketno'){
$query .= "$key=?, ";
push(@params, $basketinfo->{$key} || undef );
}
}
# get rid of the "," at the end of $query
if (substr($query, length($query)-2) eq ', '){
chop($query);
chop($query);
$query .= ' ';
}
$query .= "WHERE basketno=?";
push(@params, $basketinfo->{'basketno'});
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare($query);
$sth->execute(@params);
return;
}
#------------------------------------------------------------#
=head3 ModBasketHeader
&ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
Modifies a basket's header.
=over
=item C<$basketno> is the "basketno" field in the "aqbasket" table;
=item C<$basketname> is the "basketname" field in the "aqbasket" table;
=item C<$note> is the "note" field in the "aqbasket" table;
=item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
=item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
=item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
=item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
=item C<$billingplace> is the "billingplace" field in the aqbasket table.
=item C<$is_standing> is the "is_standing" field in the aqbasket table.
=item C<$create_items> should be set to 'ordering', 'receiving' or 'cataloguing' (or undef, in which
case the AcqCreateItem syspref takes precedence).
=back
=cut
sub ModBasketHeader {
my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items) = @_;
$is_standing ||= 0;
my $query = qq{
UPDATE aqbasket
SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=?, is_standing=?, create_items=?
WHERE basketno=?
};
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare($query);
$sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items || undef, $basketno);
if ( $contractnumber ) {
my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
my $sth2 = $dbh->prepare($query2);
$sth2->execute($contractnumber,$basketno);
}
return;
}
#------------------------------------------------------------#
=head3 GetBasketsByBookseller
@results = &GetBasketsByBookseller($booksellerid, $extra);
Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
=over
=item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
=item C<$extra> is the extra sql parameters, can be
$extra->{groupby}: group baskets by column
ex. $extra->{groupby} = aqbasket.basketgroupid
$extra->{orderby}: order baskets by column
$extra->{limit}: limit number of results (can be helpful for pagination)
=back
=cut
sub GetBasketsByBookseller {
my ($booksellerid, $extra) = @_;
my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
if ($extra){
if ($extra->{groupby}) {
$query .= " GROUP by $extra->{groupby}";
}
if ($extra->{orderby}){
$query .= " ORDER by $extra->{orderby}";
}
if ($extra->{limit}){
$query .= " LIMIT $extra->{limit}";
}
}
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare($query);
$sth->execute($booksellerid);
return $sth->fetchall_arrayref({});
}
=head3 GetBasketsInfosByBookseller
my $baskets = GetBasketsInfosByBookseller($supplierid, $allbaskets);
The optional second parameter allbaskets is a boolean allowing you to
select all baskets from the supplier; by default only active baskets (open or
closed but still something to receive) are returned.
Returns in a arrayref of hashref all about booksellers baskets, plus:
total_biblios: Number of distinct biblios in basket
total_items: Number of items in basket
expected_items: Number of non-received items in basket
=cut
sub GetBasketsInfosByBookseller {
my ($supplierid, $allbaskets) = @_;
return unless $supplierid;
my $dbh = C4::Context->dbh;
my $query = q{
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,
SUM(aqorders.quantity) AS total_items,
SUM(
IF ( aqorders.orderstatus = 'cancelled', aqorders.quantity, 0 )
) AS total_items_cancelled,
COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
SUM(
IF(aqorders.datereceived IS NULL
AND aqorders.datecancellationprinted IS NULL
, aqorders.quantity
, 0)
) AS expected_items,
SUM( aqorders.uncertainprice ) AS uncertainprices
FROM aqbasket
LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
WHERE booksellerid = ?};
$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";
unless ( $allbaskets ) {
# Don't show the basket if it's NOT CLOSED or is FULLY RECEIVED
$query.=" HAVING (closedate IS NULL OR (
SUM(
IF(aqorders.datereceived IS NULL
AND aqorders.datecancellationprinted IS NULL
, aqorders.quantity
, 0)
) > 0))"
}
my $sth = $dbh->prepare($query);
$sth->execute($supplierid);
my $baskets = $sth->fetchall_arrayref({});
# Retrieve the number of biblios cancelled
my $cancelled_biblios = $dbh->selectall_hashref( q|
SELECT COUNT(DISTINCT(biblionumber)) AS total_biblios_cancelled, aqbasket.basketno
FROM aqbasket
LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
WHERE booksellerid = ?
AND aqorders.orderstatus = 'cancelled'
GROUP BY aqbasket.basketno
, 'basketno', {}, $supplierid );
map {
$_->{total_biblios_cancelled} = $cancelled_biblios->{$_->{basketno}}{total_biblios_cancelled} || 0
} @$baskets;
return $baskets;
}
=head3 GetBasketUsers
$basketusers_ids = &GetBasketUsers($basketno);
Returns a list of all borrowernumbers that are in basket users list
=cut
sub GetBasketUsers {
my $basketno = shift;
return unless $basketno;
my $query = qq{
SELECT borrowernumber
FROM aqbasketusers
WHERE basketno = ?
};
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare($query);
$sth->execute($basketno);
my $results = $sth->fetchall_arrayref( {} );
my @borrowernumbers;
foreach (@$results) {
push @borrowernumbers, $_->{'borrowernumber'};
}
return @borrowernumbers;
}
=head3 ModBasketUsers
my @basketusers_ids = (1, 2, 3);
&ModBasketUsers($basketno, @basketusers_ids);
Delete all users from basket users list, and add users in C<@basketusers_ids>
to this users list.
=cut
sub ModBasketUsers {
my ($basketno, @basketusers_ids) = @_;
return unless $basketno;
my $dbh = C4::Context->dbh;
my $query = qq{
DELETE FROM aqbasketusers
WHERE basketno = ?
};
my $sth = $dbh->prepare($query);
$sth->execute($basketno);
$query = qq{
INSERT INTO aqbasketusers (basketno, borrowernumber)
VALUES (?, ?)
};
$sth = $dbh->prepare($query);
foreach my $basketuser_id (@basketusers_ids) {
$sth->execute($basketno, $basketuser_id);
}
return;
}
=head3 CanUserManageBasket
my $bool = CanUserManageBasket($borrower, $basket[, $userflags]);
my $bool = CanUserManageBasket($borrowernumber, $basketno[, $userflags]);
Check if a borrower can manage a basket, according to system preference
AcqViewBaskets, user permissions and basket properties (creator, users list,
branch).
First parameter can be either a borrowernumber or a hashref as returned by
Koha::Patron->unblessed
Second parameter can be either a basketno or a hashref as returned by
C4::Acquisition::GetBasket.
The third parameter is optional. If given, it should be a hashref as returned
by C4::Auth::getuserflags. If not, getuserflags is called.
If user is authorised to manage basket, returns 1.
Otherwise returns 0.
=cut
sub CanUserManageBasket {
my ($borrower, $basket, $userflags) = @_;
if (!ref $borrower) {
# FIXME This needs to be replaced
# We should not accept both scalar and array
# Tests need to be updated
$borrower = Koha::Patrons->find( $borrower )->unblessed;
}
if (!ref $basket) {
$basket = GetBasket($basket);
}
return 0 unless ($basket and $borrower);
my $borrowernumber = $borrower->{borrowernumber};
my $basketno = $basket->{basketno};
my $AcqViewBaskets = C4::Context->preference('AcqViewBaskets');
if (!defined $userflags) {
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE borrowernumber = ?");
$sth->execute($borrowernumber);
my ($flags) = $sth->fetchrow_array;
$sth->finish;
$userflags = C4::Auth::getuserflags($flags, $borrower->{userid}, $dbh);
}
unless ($userflags->{superlibrarian}
|| (ref $userflags->{acquisition} && $userflags->{acquisition}->{order_manage_all})
|| (!ref $userflags->{acquisition} && $userflags->{acquisition}))
{
if (not exists $userflags->{acquisition}) {
return 0;
}
if ( (ref $userflags->{acquisition} && !$userflags->{acquisition}->{order_manage})
|| (!ref $userflags->{acquisition} && !$userflags->{acquisition}) ) {
return 0;
}
if ($AcqViewBaskets eq 'user'
&& $basket->{authorisedby} != $borrowernumber
&& ! grep { $borrowernumber eq $_ } GetBasketUsers($basketno)) {
return 0;
}
if ($AcqViewBaskets eq 'branch' && defined $basket->{branch}
&& $basket->{branch} ne $borrower->{branchcode}) {
return 0;
}
}
return 1;
}
#------------------------------------------------------------#
=head3 GetBasketsByBasketgroup
$baskets = &GetBasketsByBasketgroup($basketgroupid);
Returns a reference to all baskets that belong to basketgroup $basketgroupid.
=cut
sub GetBasketsByBasketgroup {
my $basketgroupid = shift;
my $query = qq{
SELECT *, aqbasket.booksellerid as booksellerid
FROM aqbasket
LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?
};
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare($query);
$sth->execute($basketgroupid);
return $sth->fetchall_arrayref({});
}
#------------------------------------------------------------#
=head3 NewBasketgroup
$basketgroupid = NewBasketgroup(\%hashref);
Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
$hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
$hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
$hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
$hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
$hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
$hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
$hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
$hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
=cut
sub NewBasketgroup {
my $basketgroupinfo = shift;
die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
my $query = "INSERT INTO aqbasketgroups (";
my @params;
foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
if ( defined $basketgroupinfo->{$field} ) {
$query .= "$field, ";
push(@params, $basketgroupinfo->{$field});
}
}
$query .= "booksellerid) VALUES (";
foreach (@params) {
$query .= "?, ";
}
$query .= "?)";
push(@params, $basketgroupinfo->{'booksellerid'});
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare($query);
$sth->execute(@params);
my $basketgroupid = $dbh->{'mysql_insertid'};
if( $basketgroupinfo->{'basketlist'} ) {
foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
my $sth2 = $dbh->prepare($query2);
$sth2->execute($basketgroupid, $basketno);
}
}
return $basketgroupid;
}
#------------------------------------------------------------#
=head3 ModBasketgroup
ModBasketgroup(\%hashref);
Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
$hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
$hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
$hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
$hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
$hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
$hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
$hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
$hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
=cut
sub ModBasketgroup {
my $basketgroupinfo = shift;
die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
my $dbh = C4::Context->dbh;
my $query = "UPDATE aqbasketgroups SET ";
my @params;
foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
if ( defined $basketgroupinfo->{$field} ) {
$query .= "$field=?, ";
push(@params, $basketgroupinfo->{$field});
}
}
chop($query);
chop($query);
$query .= " WHERE id=?";
push(@params, $basketgroupinfo->{'id'});
my $sth = $dbh->prepare($query);
$sth->execute(@params);
$sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
$sth->execute($basketgroupinfo->{'id'});
if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
$sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
$sth->execute($basketgroupinfo->{'id'}, $basketno);
}
}
return;
}
#------------------------------------------------------------#
=head3 DelBasketgroup
DelBasketgroup($basketgroupid);
Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
=over
=item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
=back
=cut
sub DelBasketgroup {
my $basketgroupid = shift;
die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
my $query = "DELETE FROM aqbasketgroups WHERE id=?";
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare($query);
$sth->execute($basketgroupid);
return;
}
#------------------------------------------------------------#
=head2 FUNCTIONS ABOUT ORDERS
=head3 GetBasketgroup
$basketgroup = &GetBasketgroup($basketgroupid);
Returns a reference to the hash containing all information about the basketgroup.
=cut
sub GetBasketgroup {
my $basketgroupid = shift;
die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
my $dbh = C4::Context->dbh;
my $result_set = $dbh->selectall_arrayref(
'SELECT * FROM aqbasketgroups WHERE id=?',
{ Slice => {} },
$basketgroupid
);
return $result_set->[0]; # id is unique
}
#------------------------------------------------------------#
=head3 GetBasketgroups
$basketgroups = &GetBasketgroups($booksellerid);
Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
=cut
sub GetBasketgroups {
my $booksellerid = shift;
die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare($query);
$sth->execute($booksellerid);
return $sth->fetchall_arrayref({});
}
#------------------------------------------------------------#
=head2 FUNCTIONS ABOUT ORDERS
=head3 GetOrders
@orders = &GetOrders( $basketno, { orderby => 'biblio.title', cancelled => 0|1 } );
Looks up the pending (non-cancelled) orders with the given basket
number.
If cancelled is set, only cancelled orders will be returned.
=cut
sub GetOrders {
my ( $basketno, $params ) = @_;
return () unless $basketno;
my $orderby = $params->{orderby};
my $cancelled = $params->{cancelled} || 0;
my $dbh = C4::Context->dbh;
my $query = q|
SELECT biblio.*,biblioitems.*,
aqorders.*,
aqbudgets.*,
;
$query .= $cancelled
? q|
aqorders_transfers.ordernumber_to AS transferred_to,
aqorders_transfers.timestamp AS transferred_to_timestamp
: q|
aqorders_transfers.ordernumber_from AS transferred_from,
aqorders_transfers.timestamp AS transferred_from_timestamp
;
$query .= q|
FROM aqorders
LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
;
$query .= $cancelled
? q|
LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
: q|
LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
;
$query .= q|
WHERE basketno=?
;
if ($cancelled) {
$orderby ||= q|biblioitems.publishercode, biblio.title;
$query .= q|
AND datecancellationprinted IS NOT NULL
;
}
else {
$orderby ||=
q|aqorders.datecancellationprinted desc, aqorders.timestamp desc;
$query .= q|
AND datecancellationprinted IS NULL
;
}
$query .= " ORDER BY $orderby";
my $orders =
$dbh->selectall_arrayref( $query, { Slice => {} }, $basketno );
return @{$orders};
}
#------------------------------------------------------------#
=head3 GetOrdersByBiblionumber
@orders = &GetOrdersByBiblionumber($biblionumber);
Looks up the orders with linked to a specific $biblionumber, including
cancelled orders and received orders.
return :
C<@orders> is an array of references-to-hash, whose keys are the
fields from the aqorders, biblio, and biblioitems tables in the Koha database.
=cut
sub GetOrdersByBiblionumber {
my $biblionumber = shift;
return unless $biblionumber;
my $dbh = C4::Context->dbh;
my $query ="
SELECT biblio.*,biblioitems.*,
aqorders.*,
aqbudgets.*
FROM aqorders
LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
WHERE aqorders.biblionumber=?
";
my $result_set =
$dbh->selectall_arrayref( $query, { Slice => {} }, $biblionumber );
return @{$result_set};
}
#------------------------------------------------------------#
=head3 GetOrder
$order = &GetOrder($ordernumber);
Looks up an order by order number.
Returns a reference-to-hash describing the order. The keys of
C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
=cut
sub GetOrder {
my ($ordernumber) = @_;
return unless $ordernumber;
my $dbh = C4::Context->dbh;
my $query = qq{SELECT
aqorders.*,
biblio.title,
biblio.author,
aqbasket.basketname,
borrowers.branchcode,
biblioitems.publicationyear,
biblio.copyrightdate,
biblioitems.editionstatement,
biblioitems.isbn,
biblioitems.ean,
biblio.seriestitle,
biblioitems.publishercode,
aqorders.rrp AS unitpricesupplier,
aqorders.ecost AS unitpricelib,
aqorders.claims_count AS claims_count,
aqorders.claimed_date AS claimed_date,
aqbudgets.budget_name AS budget,
aqbooksellers.name AS supplier,
aqbooksellers.id AS supplierid,
biblioitems.publishercode AS publisher,
ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
DATE(aqbasket.closedate) AS orderdate,
aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity_to_receive,
(aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
DATEDIFF(CURDATE( ),closedate) AS latesince
FROM aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
WHERE aqorders.basketno = aqbasket.basketno
AND ordernumber=?};
my $result_set =
$dbh->selectall_arrayref( $query, { Slice => {} }, $ordernumber );
# result_set assumed to contain 1 match
return $result_set->[0];
}
=head3 GetLastOrderNotReceivedFromSubscriptionid
$order = &GetLastOrderNotReceivedFromSubscriptionid($subscriptionid);
Returns a reference-to-hash describing the last order not received for a subscription.
=cut
sub GetLastOrderNotReceivedFromSubscriptionid {
my ( $subscriptionid ) = @_;
my $dbh = C4::Context->dbh;
my $query = qq|
SELECT * FROM aqorders
LEFT JOIN subscription
ON ( aqorders.subscriptionid = subscription.subscriptionid )
WHERE aqorders.subscriptionid = ?
AND aqorders.datereceived IS NULL
LIMIT 1
;
my $result_set =
$dbh->selectall_arrayref( $query, { Slice => {} }, $subscriptionid );
# result_set assumed to contain 1 match
return $result_set->[0];
}
=head3 GetLastOrderReceivedFromSubscriptionid
$order = &GetLastOrderReceivedFromSubscriptionid($subscriptionid);
Returns a reference-to-hash describing the last order received for a subscription.
=cut
sub GetLastOrderReceivedFromSubscriptionid {
my ( $subscriptionid ) = @_;
my $dbh = C4::Context->dbh;
my $query = qq|
SELECT * FROM aqorders
LEFT JOIN subscription
ON ( aqorders.subscriptionid = subscription.subscriptionid )
WHERE aqorders.subscriptionid = ?
AND aqorders.datereceived =
(
SELECT MAX( aqorders.datereceived )
FROM aqorders
LEFT JOIN subscription
ON ( aqorders.subscriptionid = subscription.subscriptionid )
WHERE aqorders.subscriptionid = ?
AND aqorders.datereceived IS NOT NULL
)
ORDER BY ordernumber DESC
LIMIT 1
;
my $result_set =
$dbh->selectall_arrayref( $query, { Slice => {} }, $subscriptionid, $subscriptionid );
# result_set assumed to contain 1 match
return $result_set->[0];
}
#------------------------------------------------------------#
=head3 ModOrder
&ModOrder(\%hashref);
Modifies an existing order. Updates the order with order number
$hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
other keys of the hash update the fields with the same name in the aqorders
table of the Koha database.
=cut
sub ModOrder {
my $orderinfo = shift;
die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '';
my $dbh = C4::Context->dbh;
my @params;
# update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
$orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
# delete($orderinfo->{'branchcode'});
# the hash contains a lot of entries not in aqorders, so get the columns ...
my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
$sth->execute;
my $colnames = $sth->{NAME};
#FIXME Be careful. If aqorders would have columns with diacritics,
#you should need to decode what you get back from NAME.
#See report 10110 and guided_reports.pl
my $query = "UPDATE aqorders SET ";
foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
# ... and skip hash entries that are not in the aqorders table
# FIXME : probably not the best way to do it (would be better to have a correct hash)
next unless grep(/^$orderinfokey$/, @$colnames);
$query .= "$orderinfokey=?, ";
push(@params, $orderinfo->{$orderinfokey});
}
$query .= "timestamp=NOW() WHERE ordernumber=?";
push(@params, $orderinfo->{'ordernumber'} );
$sth = $dbh->prepare($query);
$sth->execute(@params);
return;
}
#------------------------------------------------------------#
=head3 ModItemOrder
ModItemOrder($itemnumber, $ordernumber);
Modifies the ordernumber of an item in aqorders_items.
=cut
sub ModItemOrder {
my ($itemnumber, $ordernumber) = @_;
return unless ($itemnumber and $ordernumber);
my $dbh = C4::Context->dbh;
my $query = qq{
UPDATE aqorders_items
SET ordernumber = ?
WHERE itemnumber = ?
};
my $sth = $dbh->prepare($query);
return $sth->execute($ordernumber, $itemnumber);
}
#------------------------------------------------------------#
=head3 ModReceiveOrder
my ( $date_received, $new_ordernumber ) = ModReceiveOrder(
{
biblionumber => $biblionumber,
order => $order,
quantityreceived => $quantityreceived,
user => $user,
invoice => $invoice,
budget_id => $budget_id,
datereceived => $datereceived,
received_itemnumbers => \@received_itemnumbers,
}
);
Updates an order, to reflect the fact that it was received, at least
in part.
If a partial order is received, splits the order into two.
Updates the order with biblionumber C<$biblionumber> and ordernumber
C<$order->{ordernumber}>.
=cut
sub ModReceiveOrder {
my ($params) = @_;
my $biblionumber = $params->{biblionumber};
my $order = { %{ $params->{order} } }; # Copy the order, we don't want to modify it
my $invoice = $params->{invoice};
my $quantrec = $params->{quantityreceived};
my $user = $params->{user};
my $budget_id = $params->{budget_id};
my $datereceived = $params->{datereceived};
my $received_items = $params->{received_items};
my $dbh = C4::Context->dbh;
$datereceived = output_pref(
{
dt => ( $datereceived ? dt_from_string( $datereceived ) : dt_from_string ),
dateformat => 'iso',
dateonly => 1,
}
);
my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
if ($suggestionid) {
ModSuggestion( {suggestionid=>$suggestionid,
STATUS=>'AVAILABLE',
biblionumber=> $biblionumber}
);
}
my $result_set = $dbh->selectrow_arrayref(
q{SELECT aqbasket.is_standing
FROM aqbasket
WHERE basketno=?},{ Slice => {} }, $order->{basketno});
my $is_standing = $result_set->[0]; # we assume we have a unique basket
my $new_ordernumber = $order->{ordernumber};
if ( $is_standing || $order->{quantity} > $quantrec ) {
# Split order line in two parts: the first is the original order line
# without received items (the quantity is decreased),
# the second part is a new order line with quantity=quantityrec
# (entirely received)
my $query = q|
UPDATE aqorders
SET quantity = ?,
orderstatus = 'partial';
$query .= q| WHERE ordernumber = ?;
my $sth = $dbh->prepare($query);
$sth->execute(
( $is_standing ? 1 : ($order->{quantity} - $quantrec) ),
$order->{ordernumber}
);
if ( not $order->{subscriptionid} && defined $order->{order_internalnote} ) {
$dbh->do(
q|UPDATE aqorders
SET order_internalnote = ?
WHERE ordernumber = ?, {},
$order->{order_internalnote}, $order->{ordernumber}
);
}
# Recalculate tax_value
$dbh->do(q|
UPDATE aqorders
SET
tax_value_on_ordering = quantity * . get_rounding_sql(q|ecost_tax_excluded) . q| * tax_rate_on_ordering,
tax_value_on_receiving = quantity * . get_rounding_sql(q|unitprice_tax_excluded) . q| * tax_rate_on_receiving
WHERE ordernumber = ?
, undef, $order->{ordernumber});
delete $order->{ordernumber};
$order->{budget_id} = ( $budget_id || $order->{budget_id} );
$order->{quantity} = $quantrec;
$order->{quantityreceived} = $quantrec;
$order->{ecost_tax_excluded} //= 0;
$order->{tax_rate_on_ordering} //= 0;
$order->{unitprice_tax_excluded} //= 0;
$order->{tax_rate_on_receiving} //= 0;
$order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($order->{ecost_tax_excluded}) * $order->{tax_rate_on_ordering};
$order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
$order->{datereceived} = $datereceived;
$order->{invoiceid} = $invoice->{invoiceid};
$order->{orderstatus} = 'complete';
$new_ordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber; # TODO What if the store fails?
if ($received_items) {
foreach my $itemnumber (@$received_items) {
ModItemOrder($itemnumber, $new_ordernumber);
}
}
} else {
my $query = q|
UPDATE aqorders
SET quantityreceived = ?,
datereceived = ?,
invoiceid = ?,
budget_id = ?,
orderstatus = 'complete'
;
$query .= q|
, replacementprice = ?
if defined $order->{replacementprice};
$query .= q|
, unitprice = ?, unitprice_tax_included = ?, unitprice_tax_excluded = ?
if defined $order->{unitprice};
$query .= q|
,tax_value_on_receiving = ?
if defined $order->{tax_value_on_receiving};
$query .= q|
,tax_rate_on_receiving = ?
if defined $order->{tax_rate_on_receiving};
$query .= q|
, order_internalnote = ?
if defined $order->{order_internalnote};
$query .= q| where biblionumber=? and ordernumber=?;
my $sth = $dbh->prepare( $query );
my @params = ( $quantrec, $datereceived, $invoice->{invoiceid}, ( $budget_id ? $budget_id : $order->{budget_id} ) );
if ( defined $order->{replacementprice} ) {
push @params, $order->{replacementprice};
}
if ( defined $order->{unitprice} ) {
push @params, $order->{unitprice}, $order->{unitprice_tax_included}, $order->{unitprice_tax_excluded};
}
if ( defined $order->{tax_value_on_receiving} ) {
push @params, $order->{tax_value_on_receiving};
}
if ( defined $order->{tax_rate_on_receiving} ) {
push @params, $order->{tax_rate_on_receiving};
}
if ( defined $order->{order_internalnote} ) {
push @params, $order->{order_internalnote};
}
push @params, ( $biblionumber, $order->{ordernumber} );
$sth->execute( @params );
# All items have been received, sent a notification to users
NotifyOrderUsers( $order->{ordernumber} );
}
return ($datereceived, $new_ordernumber);
}
=head3 CancelReceipt
my $parent_ordernumber = CancelReceipt($ordernumber);
Cancel an order line receipt and update the parent order line, as if no
receipt was made.
If items are created at receipt (AcqCreateItem = receiving) then delete
these items.
=cut
sub CancelReceipt {
my $ordernumber = shift;
return unless $ordernumber;
my $dbh = C4::Context->dbh;
my $query = qq{
SELECT datereceived, parent_ordernumber, quantity
FROM aqorders
WHERE ordernumber = ?
};
my $sth = $dbh->prepare($query);
$sth->execute($ordernumber);
my $order = $sth->fetchrow_hashref;
unless($order) {
warn "CancelReceipt: order $ordernumber does not exist";
return;
}
unless($order->{'datereceived'}) {
warn "CancelReceipt: order $ordernumber is not received";
return;
}
my $parent_ordernumber = $order->{'parent_ordernumber'};
my $order_obj = Koha::Acquisition::Orders->find( $ordernumber ); # FIXME rewrite all this subroutine using this object
my @itemnumbers = $order_obj->items->get_column('itemnumber');
if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
# The order line has no parent, just mark it as not received
$query = qq{
UPDATE aqorders
SET quantityreceived = ?,
datereceived = ?,