[Koha-patches] [PATCH] Bug 11230 - Refactor C4::Stats::UpdateStats and add UT

Mathieu Saby mathieu.saby at univ-rennes2.fr
Sun Nov 10 16:38:27 CET 2013


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.

---
  C4/Accounts.pm         |   44 ++++++++++++----
  C4/Circulation.pm      |   48 ++++++++++++-----
  C4/Stats.pm            |  121 ++++++++++++++++++++++++++++++++++---------
  t/db_dependent/Stats.t |  133 ++++++++++++++++++++++++++++++++++++++++++++++++
  4 files changed, 297 insertions(+), 49 deletions(-)
  create mode 100644 t/db_dependent/Stats.t

diff --git a/C4/Accounts.pm b/C4/Accounts.pm
index c34b330..c8e2e05 100644
--- a/C4/Accounts.pm
+++ b/C4/Accounts.pm
@@ -149,7 +149,13 @@ sub recordpayment {
      );
      $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, 0 - $amountleft, $manager_id );
  
-    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;
@@ -260,12 +266,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' ) {
@@ -659,7 +666,13 @@ sub recordpayment_selectaccts {
      '(borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding,manager_id,note) ' .
      q|VALUES (?,?,now(),?,'Payment,thanks','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({
@@ -720,7 +733,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({
@@ -804,7 +823,12 @@ sub WriteOffFee {
          }));
      }
  
-    UpdateStats( $branch, 'writeoff', $amount, q{}, q{}, q{}, $borrowernumber );
+    UpdateStats({
+                branch => $branch,
+                type => 'writeoff',
+                amount => $amount,
+                borrowernumber => $borrowernumber}
+    );
  
  }
  
diff --git a/C4/Circulation.pm b/C4/Circulation.pm
index 0a22b76..3b0a8d6 100644
--- a/C4/Circulation.pm
+++ b/C4/Circulation.pm
@@ -739,7 +739,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 }, {});
      }
@@ -1301,11 +1308,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.
@@ -1720,7 +1731,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 );
@@ -1892,13 +1903,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.
@@ -2630,7 +2643,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;
  }
  
diff --git a/C4/Stats.pm b/C4/Stats.pm
index e1cbd42..2ec5269 100644
--- a/C4/Stats.pm
+++ b/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 (", ", at 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 (", ", at 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";
      }
diff --git a/t/db_dependent/Stats.t b/t/db_dependent/Stats.t
new file mode 100644
index 0000000..5ad9608
--- /dev/null
+++ b/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;
-- 
1.7.9.5

-- 
Mathieu Saby
Service d'Informatique Documentaire
Service Commun de Documentation
Université Rennes 2
Téléphone : 02 99 14 12 65
Courriel : mathieu.saby at univ-rennes2.fr



More information about the Koha-patches mailing list