X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FStats.pm;h=6afb538092218fff114507194c74c3433f589bce;hb=eded6edacc5e3bf8dd0be21ed05842c3b78aadce;hp=959401956f7e3ece972f16ac177b6075b49a394b;hpb=594987f48622fc228a65d740a17cbbb079baf461;p=koha-ffzg.git diff --git a/C4/Stats.pm b/C4/Stats.pm index 959401956f..6afb538092 100644 --- a/C4/Stats.pm +++ b/C4/Stats.pm @@ -1,31 +1,40 @@ -package C4::Stats; #assumes C4/Stats +package C4::Stats; # 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 2 of the License, or (at your option) any later -# version. +# 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. +# 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, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . -use strict; -require Exporter; -use DBI; +use Modern::Perl; +use Carp qw( croak ); use C4::Context; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); -# set the version for version checking -$VERSION = 0.01; +use Koha::DateUtils qw( dt_from_string ); +use Koha::Statistics; +use Koha::PseudonymizedTransactions; + +our (@ISA, @EXPORT_OK); +BEGIN { + require Exporter; + @ISA = qw(Exporter); + @EXPORT_OK = qw( + UpdateStats + ); +} + =head1 NAME @@ -37,257 +46,113 @@ 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 - -=cut +=head2 UpdateStats -@ISA = qw(Exporter); -@EXPORT = qw(&UpdateStats &statsreport &Count &Overdues &TotalOwing -&TotalPaid &getcharges &Getpaidbranch &unfilledreserves); + &UpdateStats($params); -=item UpdateStats +Adds an entry to the statistics table in the Koha database, which acts as an activity log. - &UpdateStats($env, $branch, $type, $value, $other, $itemnumber, - $itemtype, $borrowernumber); +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 + ccode : the collection code of the item -Adds a line to the statistics table of the Koha database. In effect, -it logs an event. +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. -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. - -If C<$branch> is the empty string, the branch code will be taken from -C<$env-E{branchcode}>. - -C<$env-E{usercode}> specifies the value of the C field. +Returns undef if no C<$param> is given =cut -#' -sub UpdateStats { - #module to insert stats data into stats table - my ($env,$branch,$type,$amount,$other,$itemnum,$itemtype,$borrowernumber)=@_; - my $dbh = C4::Context->dbh; - if ($branch eq ''){ - $branch=$env->{'branchcode'}; - } - my $user = $env->{'usercode'}; - print $borrowernumber; - # FIXME - Use $dbh->do() instead - my $sth=$dbh->prepare("Insert into statistics - (datetime,branch,type,usercode,value, - other,itemnumber,itemtype,borrowernumber) - values (now(),'$branch','$type','$user','$amount', - '$other','$itemnum','$itemtype','$borrowernumber')"); - $sth->execute; - $sth->finish; -} - -# XXX - POD -# FIXME - Why does this function exist? Why not just rename &circrep -# to &statsreport? -# Then again, it only appears to be used in reports.pl which, in turn, -# doesn't appear to be used. So presumably this function is obsolete. -sub statsreport { - #module to return a list of stats for a given day,time,branch type - #or to return search stats - my ($type,$time)=@_; - my @data; -# print "here"; -# if ($type eq 'issue'){ - @data=circrep($time,$type); -# } - return(@data); -} - -# XXX - Doc. Only used internally. Probably useless: see comment for -# &statsreport. -sub circrep { - my ($time,$type)=@_; - my $dbh = C4::Context->dbh; - my $query="Select * from statistics"; - if ($time eq 'today'){ - # FIXME - What is this supposed to do? MySQL 3.23.42 barfs on it. - $query=$query." where type='$type' and datetime - >=datetime('yesterday'::date)"; - } - my $sth=$dbh->prepare($query); - $sth->execute; - my $i=0; - my @results; - while (my $data=$sth->fetchrow_hashref){ - $results[$i]="$data->{'datetime'}\t$data->{'branch'}"; - $i++; - } - $sth->finish; -# print $query; - return(@results); -} - -# XXX - POD -# FIXME - This is only used in stats.pl, which in turn is never used. -sub Count { - my ($type,$branch,$time,$time2)=@_; - my $dbh = C4::Context->dbh; - my $query="Select count(*) from statistics where type='$type'"; - $query.=" and datetime >= '$time' and datetime< '$time2' and branch='$branch'"; - my $sth=$dbh->prepare($query); - $sth->execute; - my $data=$sth->fetchrow_hashref; - $sth->finish; -# print $query; - return($data->{'count(*)'}); -} -# XXX - POD. Doesn't appear to be used -sub Overdues{ - my $dbh = C4::Context->dbh; - my $query="Select count(*) from issues where date_due >= now()"; - my $sth=$dbh->prepare($query); - $sth->execute; - my $count=$sth->fetchrow_hashref; - $sth->finish; - return($count->{'count(*)'}); -} - -# XXX - POD. Never used -sub TotalOwing{ - my ($type)=@_; - my $dbh = C4::Context->dbh; - my $query="Select sum(amountoutstanding) from accountlines"; - if ($type eq 'fine'){ - $query=$query." where accounttype='F' or accounttype='FN'"; - } - my $sth=$dbh->prepare($query); -# print $query; - $sth->execute; - my $total=$sth->fetchrow_hashref; - $sth->finish; - return($total->{'sum(amountoutstanding)'}); -} - -# XXX - POD. Never used -sub TotalPaid { - my ($time)=@_; - my $dbh = C4::Context->dbh; - my $query="Select * from accountlines,borrowers where (accounttype = 'Pay' -or accounttype ='W') - and accountlines.borrowernumber = borrowers.borrowernumber"; - if ($time eq 'today'){ - $query=$query." and date = now()"; - } else { - $query.=" and date='$time'"; - } -# my $query="Select * from statistics,borrowers -# where statistics.borrowernumber= borrowers.borrowernumber -# and (statistics.type='payment' or statistics.type='writeoff') "; -# if ($time eq 'today'){ -# $query=$query." and datetime = now()"; -# } else { -# $query.=" and datetime > '$time'"; -# } - $query.=" order by timestamp"; -# print $query; - my $sth=$dbh->prepare($query); - $sth->execute; - my @results; - my $i=0; - while (my $data=$sth->fetchrow_hashref){ - $results[$i]=$data; - $i++; - } - $sth->finish; -# print $query; - return(@results); -} - -# XXX - POD. Only used in stats.pl, which in turn is never used. -sub getcharges{ - my($borrowerno,$timestamp)=@_; - my $dbh = C4::Context->dbh; - my $timestamp2=$timestamp-1; - my $query="Select * from accountlines where borrowernumber=$borrowerno - and timestamp = '$timestamp' and accounttype <> 'Pay' and - accounttype <> 'W'"; - my $sth=$dbh->prepare($query); -# print $query,"
"; - $sth->execute; - my $i=0; - my @results; - while (my $data=$sth->fetchrow_hashref){ -# if ($data->{'timestamp'} == $timestamp){ - $results[$i]=$data; - $i++; -# } - } - return(@results); -} - -# XXX - POD. This is only used in stats.pl and stats2.pl, neither of -# which is used. -sub Getpaidbranch{ - my($date,$borrno)=@_; - my $dbh = C4::Context->dbh; - my $query="select * from statistics where type='payment' and datetime - >'$date' and borrowernumber='$borrno'"; - my $sth=$dbh->prepare($query); - $sth->execute; -# print $query; - my $data=$sth->fetchrow_hashref; - $sth->finish; - return($data->{'branch'}); -} - -# XXX - POD. This is only used in reservereport.pl and -# reservereport.xls, neither of which is used. -sub unfilledreserves { - my $dbh = C4::Context->dbh; - my $query="select *,biblio.title from reserves,reserveconstraints,biblio,borrowers,biblioitems where found <> 'F' and cancellationdate -is NULL and biblio.biblionumber=reserves.biblionumber and -reserves.constrainttype='o' -and (reserves.biblionumber=reserveconstraints.biblionumber -and reserves.borrowernumber=reserveconstraints.borrowernumber) -and -reserves.borrowernumber=borrowers.borrowernumber and -biblioitems.biblioitemnumber=reserveconstraints.biblioitemnumber order by -biblio.title,reserves.reservedate"; - my $sth=$dbh->prepare($query); - $sth->execute; - my $i=0; - my @results; - while (my $data=$sth->fetchrow_hashref){ - $results[$i]=$data; - $i++; - } - $sth->finish; - $query="select *,biblio.title from reserves,biblio,borrowers where found <> 'F' and cancellationdate -is NULL and biblio.biblionumber=reserves.biblionumber and reserves.constrainttype='a' and -reserves.borrowernumber=borrowers.borrowernumber -order by -biblio.title,reserves.reservedate"; - $sth=$dbh->prepare($query); - $sth->execute; - while (my $data=$sth->fetchrow_hashref){ - $results[$i]=$data; - $i++; - } - $sth->finish; - return($i,\@results); +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 ccode location); + my @allowed_circulation_types = qw (renew issue localuse return onsite_checkout recall); + 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 did 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 did not received mandatory param(s): ".join (", ",@missing_params )); + } + my @invalid_params = (); + for my $myparam (keys %$params ) { + push @invalid_params, $myparam unless grep { $_ eq $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} : undef; + my $amount = exists $params->{amount} ? $params->{amount} : 0; + my $other = exists $params->{other} ? $params->{other} : ''; + my $itemtype = exists $params->{itemtype} ? $params->{itemtype} : ''; + my $location = exists $params->{location} ? $params->{location} : undef; + my $ccode = exists $params->{ccode} ? $params->{ccode} : ''; + + my $dtf = Koha::Database->new->schema->storage->datetime_parser; + my $statistic = Koha::Statistic->new( + { + datetime => $dtf->format_datetime( dt_from_string ), + branch => $branch, + type => $type, + value => $amount, + other => $other, + itemnumber => $itemnumber, + itemtype => $itemtype, + location => $location, + borrowernumber => $borrowernumber, + ccode => $ccode, + } + )->store; + + Koha::PseudonymizedTransaction->new_from_statistic($statistic)->store + if C4::Context->preference('Pseudonymization') + && $borrowernumber # Not a real transaction if the patron does not exist + # For instance can be a transfer, or hold trigger + && grep { $_ eq $params->{type} } qw(renew issue return onsite_checkout); } -END { } # module clean-up code here (global destructor) - 1; __END__ -=back =head1 AUTHOR -Koha Developement team +Koha Development Team =cut +