Browse Source

Bug 11230 - Refactor C4::Stats::UpdateStats and add UT

This patch
- refactors C4::Stats::UpdateStats (it now takes a hashref as unique parameter, instead of a list of parameters)
- add UT for it
- change the calls made to this sub in C4::Accounts and C4::Circulation

Additionnaly it also
- adds POD to C4::Stats::TotalPaid
- adds some comments to C4::Stats::TotalPaid (I think I found some errors in it)

To test :
1. run "prove t/db_dependant/Stats.t -v"
2. make some circulation operations (checkout, checkin, renew, localuse)
check the operations are rightly recorded in Statistics table (with a SQL query like "SELECT * FROM statistics WHERE datetime LIKE "2013-11-15%", if you run your test on the 15th november)
3. make some fine payments operations (writeoff, payment)
check the operations are rightly recorded in Statistics table (with a SQL query like "SELECT * FROM statistics WHERE datetime LIKE "2013-11-15%", if you run your test on the 15th november)

Note that there is probably an issue to fix in Accounts.pm : the user is saved instead of the branch. But this is not the purpose of this patch, so I kept the previous behavior for the moment.

Signed-off-by: Bernardo Gonzalez Kriegel <bgkriegel@gmail.com>
Work, test pass, isse/return/writeoff recorded on statistics
Removed a "=back" to make happy koha-qa
No other errors

Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>
Signed-off-by: Tomas Cohen Arazi <tomascohen@gmail.com>
MM-OPAC/theme_dep
Mathieu Saby 9 years ago
committed by Tomas Cohen Arazi
parent
commit
8a02608a47
  1. 44
      C4/Accounts.pm
  2. 48
      C4/Circulation.pm
  3. 123
      C4/Stats.pm
  4. 133
      t/db_dependent/Stats.t

44
C4/Accounts.pm

@ -155,7 +155,13 @@ sub recordpayment {
$usth->execute( $borrowernumber, $nextaccntno, 0 - $data, $paytype, 0 - $amountleft, $manager_id );
$usth->finish;
UpdateStats( $branch, 'payment', $data, '', '', '', $borrowernumber, $nextaccntno );
UpdateStats({
branch => $branch,
type =>'payment',
amount => $data,
borrowernumber => $borrowernumber,
accountno => $nextaccntno }
);
if ( C4::Context->preference("FinesLog") ) {
$accdata->{'amountoutstanding_new'} = $newamtos;
@ -266,12 +272,13 @@ sub makepayment {
}));
}
# FIXME - The second argument to &UpdateStats is supposed to be the
# branch code.
# UpdateStats is now being passed $accountno too. MTJ
UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber,
$accountno );
UpdateStats({
branch => $user,
type => 'payment',
amount => $amount,
borrowernumber => $borrowernumber,
accountno => $accountno}
);
#check to see what accounttype
if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
@ -648,7 +655,13 @@ sub recordpayment_selectaccts {
'(borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding,manager_id,note) ' .
q|VALUES (?,?,now(),?,'','Pay',?,?,?)|;
$dbh->do($sql,{},$borrowernumber, $nextaccntno, 0 - $amount, 0 - $amountleft, $manager_id, $note );
UpdateStats( $branch, 'payment', $amount, '', '', '', $borrowernumber, $nextaccntno );
UpdateStats({
branch => $branch,
type => 'payment',
amount => $amount,
borrowernumber => $borrowernumber,
accountno => $nextaccntno}
);
if ( C4::Context->preference("FinesLog") ) {
logaction("FINES", 'CREATE',$borrowernumber,Dumper({
@ -709,7 +722,13 @@ sub makepartialpayment {
$dbh->do( $insert, undef, $borrowernumber, $nextaccntno, $amount,
"Payment, thanks - $user", 'Pay', $data->{'itemnumber'}, $manager_id, $payment_note);
UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber, $accountno );
UpdateStats({
branch => $user,
type => 'payment',
amount => $amount,
borrowernumber => $borrowernumber,
accountno => $accountno}
);
if ( C4::Context->preference("FinesLog") ) {
logaction("FINES", 'CREATE',$borrowernumber,Dumper({
@ -793,7 +812,12 @@ sub WriteOffFee {
}));
}
UpdateStats( $branch, 'writeoff', $amount, q{}, q{}, q{}, $borrowernumber );
UpdateStats({
branch => $branch,
type => 'writeoff',
amount => $amount,
borrowernumber => $borrowernumber}
);
}

48
C4/Circulation.pm

@ -740,7 +740,14 @@ sub CanBookBeIssued {
#
if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) {
# stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
&UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'}, undef, $item->{'ccode'});
&UpdateStats({
branch => C4::Context->userenv->{'branch'},
type => 'localuse',
itemnumber => $item->{'itemnumber'},
itemtype => $item->{'itemtype'},
borrowernumber => $borrower->{'borrowernumber'},
ccode => $item->{'ccode'}}
);
ModDateLastSeen( $item->{'itemnumber'} );
return( { STATS => 1 }, {});
}
@ -1299,11 +1306,15 @@ sub AddIssue {
}
# Record the fact that this book was issued.
&UpdateStats(
C4::Context->userenv->{'branch'},
'issue', $charge,
($sipmode ? "SIP-$sipmode" : ''), $item->{'itemnumber'},
$item->{'itype'}, $borrower->{'borrowernumber'}, undef, $item->{'ccode'}
&UpdateStats({
branch => C4::Context->userenv->{'branch'},
type => 'issue',
amount => $charge,
other => ($sipmode ? "SIP-$sipmode" : ''),
itemnumber => $item->{'itemnumber'},
itemtype => $item->{'itype'},
borrowernumber => $borrower->{'borrowernumber'},
ccode => $item->{'ccode'}}
);
# Send a checkout slip.
@ -1721,7 +1732,7 @@ sub AddReturn {
my $biblio;
my $doreturn = 1;
my $validTransfert = 0;
my $stat_type = 'return';
my $stat_type = 'return';
# get information on item
my $itemnumber = GetItemnumberFromBarcode( $barcode );
@ -1937,13 +1948,15 @@ sub AddReturn {
$messages->{'ResFound'} = $resrec;
}
# update stats?
# Record the fact that this book was returned.
UpdateStats(
$branch, $stat_type, '0', '',
$item->{'itemnumber'},
$biblio->{'itemtype'},
$borrowernumber, undef, $item->{'ccode'}
# FIXME itemtype should record item level type, not bibliolevel type
UpdateStats({
branch => $branch,
type => $stat_type,
itemnumber => $item->{'itemnumber'},
itemtype => $biblio->{'itemtype'},
borrowernumber => $borrowernumber,
ccode => $item->{'ccode'}}
);
# Send a check-in slip. # NOTE: borrower may be undef. probably shouldn't try to send messages then.
@ -2774,7 +2787,14 @@ sub AddRenewal {
}
# Log the renewal
UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber, undef, $item->{'ccode'});
UpdateStats({branch => $branch,
type => 'renew',
amount => $charge,
itemnumber => $itemnumber,
itemtype => $item->{itype},
borrowernumber => $borrowernumber,
ccode => $item->{'ccode'}}
);
return $datedue;
}

123
C4/Stats.pm

@ -21,6 +21,7 @@ package C4::Stats;
use strict;
use warnings;
require Exporter;
use Carp;
use C4::Context;
use C4::Debug;
use vars qw($VERSION @ISA @EXPORT);
@ -48,60 +49,128 @@ C4::Stats - Update Koha statistics (log)
=head1 DESCRIPTION
The C<&UpdateStats> function adds an entry to the statistics table in
the Koha database, which acts as an activity log.
The functions of this module deals with statistics table of Koha database.
=head1 FUNCTIONS
=over 2
=head2 UpdateStats
=item UpdateStats
&UpdateStats($params);
&UpdateStats($branch, $type, $value, $other, $itemnumber,
$itemtype, $borrowernumber);
Adds an entry to the statistics table in the Koha database, which acts as an activity log.
Adds a line to the statistics table of the Koha database. In effect,
it logs an event.
C<$params> is an hashref whose expected keys are:
branch : the branch where the transaction occurred
type : the type of transaction (renew, issue, localuse, return, writeoff, payment
itemnumber : the itemnumber of the item
borrowernumber : the borrowernumber of the patron
amount : the amount of the transaction
other : sipmode
itemtype : the type of the item
accountno : the count
ccode : the collection code of the item
C<$branch>, C<$type>, C<$value>, C<$other>, C<$itemnumber>,
C<$itemtype>, and C<$borrowernumber> correspond to the fields of the
statistics table in the Koha database.
type key is mandatory.
For types used in C4::Circulation (renew,issue,localuse,return), the following other keys are mandatory:
branch, borrowernumber, itemnumber, ccode, itemtype
For types used in C4::Accounts (writeoff, payment), the following other keys are mandatory:
branch, borrowernumber, itemnumber, ccode, itemtype
If an optional key is not provided, the value '' is used for this key.
Returns undef if no C<$param> is given
=cut
#'
sub UpdateStats {
my ($params) = @_;
# make some controls
return () if ! defined $params;
# change these arrays if new types of transaction or new parameters are allowed
my @allowed_keys = qw (type branch amount other itemnumber itemtype borrowernumber accountno ccode);
my @allowed_circulation_types = qw (renew issue localuse return);
my @allowed_accounts_types = qw (writeoff payment);
my @circulation_mandatory_keys = qw (type branch borrowernumber itemnumber ccode itemtype);
my @accounts_mandatory_keys = qw (type branch borrowernumber amount);
my @mandatory_keys = ();
if (! exists $params->{type} or ! defined $params->{type}) {
croak ("UpdateStats does not received type param");
}
if (grep ($_ eq $params->{type}, @allowed_circulation_types )) {
@mandatory_keys = @circulation_mandatory_keys;
} elsif (grep ($_ eq $params->{type}, @allowed_accounts_types )) {
@mandatory_keys = @accounts_mandatory_keys;
} else {
croak ("UpdateStats received forbidden type param: ".$params->{type});
}
my @missing_params = ();
for my $mykey (@mandatory_keys ) {
push @missing_params, $mykey if !grep (/^$mykey/, keys $params);
}
if (scalar @missing_params > 0 ) {
croak ("UpdateStats does not received mandatory param(s): ".join (", ",@missing_params ));
}
my @invalid_params = ();
for my $myparam (keys $params ) {
push @invalid_params, $myparam unless grep (/^$myparam$/, @allowed_keys);
}
if (scalar @invalid_params > 0 ) {
croak ("UpdateStats received invalid param(s): ".join (", ",@invalid_params ));
}
# get the parameters
my $branch = $params->{branch};
my $type = $params->{type};
my $borrowernumber = exists $params->{borrowernumber} ? $params->{borrowernumber} :'';
my $itemnumber = exists $params->{itemnumber} ? $params->{itemnumber} :'';
my $amount = exists $params->{amount} ? $params->{amount} :'';
my $other = exists $params->{other} ? $params->{other} :'';
my $itemtype = exists $params->{itemtype} ? $params->{itemtype} :'';
my $accountno = exists $params->{accountno} ? $params->{accountno} :'';
my $ccode = exists $params->{ccode} ? $params->{ccode} :'';
#module to insert stats data into stats table
my (
$branch, $type,
$amount, $other, $itemnum,
$itemtype, $borrowernumber, $accountno, $ccode
)
= @_;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare(
"INSERT INTO statistics
(datetime, branch, type, value,
other, itemnumber, itemtype, borrowernumber, proccode, ccode)
(datetime,
branch, type, value,
other, itemnumber, itemtype,
borrowernumber, proccode, ccode)
VALUES (now(),?,?,?,?,?,?,?,?,?)"
);
$sth->execute(
$branch, $type, $amount,
$other, $itemnum, $itemtype, $borrowernumber,
$accountno, $ccode
$branch, $type, $amount,
$other, $itemnumber, $itemtype,
$borrowernumber, $accountno, $ccode
);
}
# Otherwise, it'd need a POD.
=head2 TotalPaid
@total = &TotalPaid ( $time, [$time2], [$spreadsheet ]);
Returns an array containing the payments and writeoffs made between two dates
C<$time> and C<$time2>, or on a specific one, or from C<$time> onwards.
C<$time> param is mandatory.
If C<$time> eq 'today', returns are limited to the current day
If C<$time2> eq '', results are returned from C<$time> onwards.
If C<$time2> is undef, returns are limited to C<$time>
C<$spreadsheet> param is optional and controls the sorting of the results.
Returns undef if no param is given
=cut
sub TotalPaid {
my ( $time, $time2, $spreadsheet ) = @_;
return () unless (defined $time);
$time2 = $time unless $time2;
my $dbh = C4::Context->dbh;
my $query = "SELECT * FROM statistics
LEFT JOIN borrowers ON statistics.borrowernumber= borrowers.borrowernumber
WHERE (statistics.type='payment' OR statistics.type='writeoff') ";
if ( $time eq 'today' ) {
# FIXME wrong condition. Now() will not get all the payments of the day but of a specific timestamp
$query .= " AND datetime = now()";
} else {
$query .= " AND datetime > '$time'"; # FIXME: use placeholders
@ -109,6 +178,8 @@ sub TotalPaid {
if ( $time2 ne '' ) {
$query .= " AND datetime < '$time2'"; # FIXME: use placeholders
}
# FIXME if $time2 is undef, query will be "AND datetime > $time AND AND datetime < $time"
# Operators should probably be <= and >=
if ($spreadsheet) {
$query .= " ORDER BY branch, type";
}
@ -121,8 +192,6 @@ sub TotalPaid {
1;
__END__
=back
=head1 AUTHOR
Koha Development Team <http://koha-community.org/>

133
t/db_dependent/Stats.t

@ -0,0 +1,133 @@
#!/usr/bin/perl
use Modern::Perl;
use C4::Stats;
use Test::More tests => 17;
BEGIN {
use_ok('C4::Stats');
}
can_ok(
'C4::Stats',
qw(UpdateStats
TotalPaid
)
);
#Start transaction
my $dbh = C4::Context->dbh;
$dbh->{RaiseError} = 1;
$dbh->{AutoCommit} = 0;
#
# Test UpdateStats
#
is (UpdateStats () ,undef, "UpdateStats returns undef if no params");
my $params = {
branch => "BRA",
itemnumber => 31,
borrowernumber => 5,
amount =>5.1,
other => "bla",
itemtype => "BK",
accountno => 51,
ccode => "CODE",
};
my $return_error;
# returns undef and croaks if type is not allowed
$params -> {type} = "bla";
eval {UpdateStats($params)};
$return_error = $@;
isnt ($return_error,'',"UpdateStats returns undef and croaks if type is not allowed");
delete $params->{type};
# returns undef and croaks if type is missing
eval {UpdateStats($params)};
$return_error = $@;
isnt ($return_error,'',"UpdateStats returns undef and croaks if no type given");
$params -> {type} = undef;
# returns undef and croaks if type is undef
eval {UpdateStats($params)};
$return_error = $@;
isnt ($return_error,'',"UpdateStats returns undef and croaks if type is undef");
# returns undef and croaks if mandatory params are missing
my @allowed_circulation_types = qw (renew issue localuse return);
my @allowed_accounts_types = qw (writeoff payment);
my @circulation_mandatory_keys = qw (branch borrowernumber itemnumber ccode itemtype); #don't check type here
my @accounts_mandatory_keys = qw (branch borrowernumber amount); #don't check type here
my @missing_errors = ();
foreach my $key (@circulation_mandatory_keys) {
my $value = $params->{$key};
delete $params->{$key};
foreach my $type (@allowed_circulation_types) {
$params->{type} = $type;
eval {UpdateStats($params)};
$return_error = $@;
push @missing_errors, "key:$key for type:$type" unless $return_error;
}
$params->{$key} = $value;
}
foreach my $key (@accounts_mandatory_keys) {
my $value = $params->{$key};
delete $params->{$key};
foreach my $type (@allowed_accounts_types) {
$params->{type} = $type;
eval {UpdateStats($params)};
$return_error = $@;
push @missing_errors, "key:$key for type:$type" unless $return_error;
}
$params->{$key} = $value;
}
is (join (", ", @missing_errors),'',"UpdateStats returns undef and croaks if mandatory params are missing");
# returns undef and croaks if forbidden params are given
$params -> {type} = "return";
$params -> {newparam} = "true";
eval {UpdateStats($params)};
$return_error = $@;
isnt ($return_error,'',"UpdateStats returns undef and croaks if a forbidden param is given");
delete $params->{newparam};
# save the params in the right database fields
$dbh->do(q|DELETE FROM statistics|);
$params = {
branch => "BRA",
itemnumber => 31,
borrowernumber => 5,
amount =>5.1,
other => "bla",
itemtype => "BK",
accountno => 51,
ccode => "CODE",
type => "return"
};
UpdateStats ($params);
my $sth = $dbh->prepare("SELECT * FROM statistics");
$sth->execute();
my $line = ${ $sth->fetchall_arrayref( {} ) }[0];
is ($params-> {branch}, $line->{branch}, "UpdateStats save branch param in branch field of statistics table");
is ($params-> {type}, $line->{type}, "UpdateStats save type param in type field of statistics table");
is ($params-> {borrowernumber}, $line->{borrowernumber}, "UpdateStats save borrowernumber param in borrowernumber field of statistics table");
cmp_ok($params-> {amount},'==', $line->{value}, "UpdateStats save amount param in value field of statistics table");
is ($params-> {other}, $line->{other}, "UpdateStats save other param in other field of statistics table");
is ($params-> {itemtype}, $line->{itemtype}, "UpdateStats save itemtype param in itemtype field of statistics table");
is ($params-> {accountno}, $line->{proccode}, "UpdateStats save accountno param in proccode field of statistics table");
is ($params-> {ccode}, $line->{ccode}, "UpdateStats save ccode param in ccode field of statistics table");
#
# Test TotalPaid
#
is (TotalPaid (),undef,"TotalPaid returns undef if no params are given");
# More tests to write!
#End transaction
$dbh->rollback;
Loading…
Cancel
Save