View | Details | Raw Unified | Return to bug 11230
Collapse All | Expand All

(-)a/C4/Accounts.pm (-10 / +34 lines)
Lines 149-155 sub recordpayment { Link Here
149
    );
149
    );
150
    $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, 0 - $amountleft, $manager_id );
150
    $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, 0 - $amountleft, $manager_id );
151
151
152
    UpdateStats( $branch, 'payment', $data, '', '', '', $borrowernumber, $nextaccntno );
152
    UpdateStats({
153
                branch => $branch,
154
                type =>'payment',
155
                amount => $data,
156
                borrowernumber => $borrowernumber,
157
                accountno => $nextaccntno }
158
    );
153
159
154
    if ( C4::Context->preference("FinesLog") ) {
160
    if ( C4::Context->preference("FinesLog") ) {
155
        $accdata->{'amountoutstanding_new'} = $newamtos;
161
        $accdata->{'amountoutstanding_new'} = $newamtos;
Lines 260-271 sub makepayment { Link Here
260
        }));
266
        }));
261
    }
267
    }
262
268
263
269
    UpdateStats({
264
    # FIXME - The second argument to &UpdateStats is supposed to be the
270
                branch => $user,
265
    # branch code.
271
                type => 'payment',
266
    # UpdateStats is now being passed $accountno too. MTJ
272
                amount => $amount,
267
    UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber,
273
                borrowernumber => $borrowernumber,
268
        $accountno );
274
                accountno => $accountno}
275
    );
269
276
270
    #check to see what accounttype
277
    #check to see what accounttype
271
    if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
278
    if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
Lines 659-665 sub recordpayment_selectaccts { Link Here
659
    '(borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding,manager_id,note) ' .
666
    '(borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding,manager_id,note) ' .
660
    q|VALUES (?,?,now(),?,'Payment,thanks','Pay',?,?,?)|;
667
    q|VALUES (?,?,now(),?,'Payment,thanks','Pay',?,?,?)|;
661
    $dbh->do($sql,{},$borrowernumber, $nextaccntno, 0 - $amount, 0 - $amountleft, $manager_id, $note );
668
    $dbh->do($sql,{},$borrowernumber, $nextaccntno, 0 - $amount, 0 - $amountleft, $manager_id, $note );
662
    UpdateStats( $branch, 'payment', $amount, '', '', '', $borrowernumber, $nextaccntno );
669
    UpdateStats({
670
                branch => $branch,
671
                type => 'payment',
672
                amount => $amount,
673
                borrowernumber => $borrowernumber,
674
                accountno => $nextaccntno}
675
    );
663
676
664
    if ( C4::Context->preference("FinesLog") ) {
677
    if ( C4::Context->preference("FinesLog") ) {
665
        logaction("FINES", 'CREATE',$borrowernumber,Dumper({
678
        logaction("FINES", 'CREATE',$borrowernumber,Dumper({
Lines 720-726 sub makepartialpayment { Link Here
720
    $dbh->do(  $insert, undef, $borrowernumber, $nextaccntno, $amount,
733
    $dbh->do(  $insert, undef, $borrowernumber, $nextaccntno, $amount,
721
        "Payment, thanks - $user", 'Pay', $data->{'itemnumber'}, $manager_id, $payment_note);
734
        "Payment, thanks - $user", 'Pay', $data->{'itemnumber'}, $manager_id, $payment_note);
722
735
723
    UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber, $accountno );
736
    UpdateStats({
737
                branch => $user,
738
                type => 'payment',
739
                amount => $amount,
740
                borrowernumber => $borrowernumber,
741
                accountno => $accountno}
742
    );
724
743
725
    if ( C4::Context->preference("FinesLog") ) {
744
    if ( C4::Context->preference("FinesLog") ) {
726
        logaction("FINES", 'CREATE',$borrowernumber,Dumper({
745
        logaction("FINES", 'CREATE',$borrowernumber,Dumper({
Lines 804-810 sub WriteOffFee { Link Here
804
        }));
823
        }));
805
    }
824
    }
806
825
807
    UpdateStats( $branch, 'writeoff', $amount, q{}, q{}, q{}, $borrowernumber );
826
    UpdateStats({
827
                branch => $branch,
828
                type => 'writeoff',
829
                amount => $amount,
830
                borrowernumber => $borrowernumber}
831
    );
808
832
809
}
833
}
810
834
(-)a/C4/Circulation.pm (-14 / +34 lines)
Lines 739-745 sub CanBookBeIssued { Link Here
739
    #
739
    #
740
    if ( $borrower->{'category_type'} eq 'X' && (  $item->{barcode}  )) { 
740
    if ( $borrower->{'category_type'} eq 'X' && (  $item->{barcode}  )) { 
741
    	# stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1  .
741
    	# stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1  .
742
        &UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'}, undef, $item->{'ccode'});
742
        &UpdateStats({
743
                     branch => C4::Context->userenv->{'branch'},
744
                     type => 'localuse',
745
                     itemnumber => $item->{'itemnumber'},
746
                     itemtype => $item->{'itemtype'},
747
                     borrowernumber => $borrower->{'borrowernumber'},
748
                     ccode => $item->{'ccode'}}
749
                    );
743
        ModDateLastSeen( $item->{'itemnumber'} );
750
        ModDateLastSeen( $item->{'itemnumber'} );
744
        return( { STATS => 1 }, {});
751
        return( { STATS => 1 }, {});
745
    }
752
    }
Lines 1301-1311 sub AddIssue { Link Here
1301
        }
1308
        }
1302
1309
1303
        # Record the fact that this book was issued.
1310
        # Record the fact that this book was issued.
1304
        &UpdateStats(
1311
        &UpdateStats({
1305
            C4::Context->userenv->{'branch'},
1312
                      branch => C4::Context->userenv->{'branch'},
1306
            'issue', $charge,
1313
                      type => 'issue',
1307
            ($sipmode ? "SIP-$sipmode" : ''), $item->{'itemnumber'},
1314
                      amount => $charge,
1308
            $item->{'itype'}, $borrower->{'borrowernumber'}, undef, $item->{'ccode'}
1315
                      other => ($sipmode ? "SIP-$sipmode" : ''),
1316
                      itemnumber => $item->{'itemnumber'},
1317
                      itemtype => $item->{'itype'},
1318
                      borrowernumber => $borrower->{'borrowernumber'},
1319
                      ccode => $item->{'ccode'}}
1309
        );
1320
        );
1310
1321
1311
        # Send a checkout slip.
1322
        # Send a checkout slip.
Lines 1720-1726 sub AddReturn { Link Here
1720
    my $biblio;
1731
    my $biblio;
1721
    my $doreturn       = 1;
1732
    my $doreturn       = 1;
1722
    my $validTransfert = 0;
1733
    my $validTransfert = 0;
1723
    my $stat_type = 'return';    
1734
    my $stat_type = 'return';
1724
1735
1725
    # get information on item
1736
    # get information on item
1726
    my $itemnumber = GetItemnumberFromBarcode( $barcode );
1737
    my $itemnumber = GetItemnumberFromBarcode( $barcode );
Lines 1892-1904 sub AddReturn { Link Here
1892
        $messages->{'ResFound'} = $resrec;
1903
        $messages->{'ResFound'} = $resrec;
1893
    }
1904
    }
1894
1905
1895
    # update stats?
1896
    # Record the fact that this book was returned.
1906
    # Record the fact that this book was returned.
1897
    UpdateStats(
1907
    # FIXME itemtype should record item level type, not bibliolevel type
1898
        $branch, $stat_type, '0', '',
1908
    UpdateStats({
1899
        $item->{'itemnumber'},
1909
                branch => $branch,
1900
        $biblio->{'itemtype'},
1910
                type => $stat_type,
1901
        $borrowernumber, undef, $item->{'ccode'}
1911
                itemnumber => $item->{'itemnumber'},
1912
                itemtype => $biblio->{'itemtype'},
1913
                borrowernumber => $borrowernumber,
1914
                ccode => $item->{'ccode'}}
1902
    );
1915
    );
1903
1916
1904
    # Send a check-in slip. # NOTE: borrower may be undef.  probably shouldn't try to send messages then.
1917
    # Send a check-in slip. # NOTE: borrower may be undef.  probably shouldn't try to send messages then.
Lines 2630-2636 sub AddRenewal { Link Here
2630
    }
2643
    }
2631
2644
2632
    # Log the renewal
2645
    # Log the renewal
2633
    UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber, undef, $item->{'ccode'});
2646
    UpdateStats({branch => $branch,
2647
                type => 'renew',
2648
                amount => $charge,
2649
                itemnumber => $itemnumber,
2650
                itemtype => $item->{itype},
2651
                borrowernumber => $borrowernumber,
2652
                ccode => $item->{'ccode'}}
2653
                );
2634
	return $datedue;
2654
	return $datedue;
2635
}
2655
}
2636
2656
(-)a/C4/Stats.pm (-25 / +96 lines)
Lines 21-26 package C4::Stats; Link Here
21
use strict;
21
use strict;
22
use warnings;
22
use warnings;
23
require Exporter;
23
require Exporter;
24
use Carp;
24
use C4::Context;
25
use C4::Context;
25
use C4::Debug;
26
use C4::Debug;
26
use vars qw($VERSION @ISA @EXPORT);
27
use vars qw($VERSION @ISA @EXPORT);
Lines 48-107 C4::Stats - Update Koha statistics (log) Link Here
48
49
49
=head1 DESCRIPTION
50
=head1 DESCRIPTION
50
51
51
The C<&UpdateStats> function adds an entry to the statistics table in
52
The functions of this module deals with statistics table of Koha database.
52
the Koha database, which acts as an activity log.
53
53
54
=head1 FUNCTIONS
54
=head1 FUNCTIONS
55
55
56
=over 2
56
=head2 UpdateStats
57
57
58
=item UpdateStats
58
  &UpdateStats($params);
59
59
60
  &UpdateStats($branch, $type, $value, $other, $itemnumber,
60
Adds an entry to the statistics table in the Koha database, which acts as an activity log.
61
               $itemtype, $borrowernumber);
62
61
63
Adds a line to the statistics table of the Koha database. In effect,
62
C<$params> is an hashref whose expected keys are:
64
it logs an event.
63
    branch             : the branch where the transaction occurred
64
    type               : the type of transaction (renew, issue, localuse, return, writeoff, payment
65
    itemnumber         : the itemnumber of the item
66
    borrowernumber     : the borrowernumber of the patron
67
    amount             : the amount of the transaction
68
    other              : sipmode
69
    itemtype           : the type of the item
70
    accountno          : the count 
71
    ccode              : the collection code of the item
65
72
66
C<$branch>, C<$type>, C<$value>, C<$other>, C<$itemnumber>,
73
type key is mandatory.
67
C<$itemtype>, and C<$borrowernumber> correspond to the fields of the
74
For types used in C4::Circulation (renew,issue,localuse,return), the following other keys are mandatory:
68
statistics table in the Koha database.
75
branch, borrowernumber, itemnumber, ccode, itemtype
76
For types used in C4::Accounts (writeoff, payment), the following other keys are mandatory:
77
branch, borrowernumber, itemnumber, ccode, itemtype
78
If an optional key is not provided, the value '' is used for this key.
79
80
Returns undef if no C<$param> is given
69
81
70
=cut
82
=cut
71
83
72
#'
73
sub UpdateStats {
84
sub UpdateStats {
85
    my ($params) = @_;
86
# make some controls
87
    return () if ! defined $params;
88
# change these arrays if new types of transaction or new parameters are allowed
89
    my @allowed_keys = qw (type branch amount other itemnumber itemtype borrowernumber accountno ccode);
90
    my @allowed_circulation_types = qw (renew issue localuse return);
91
    my @allowed_accounts_types = qw (writeoff payment);
92
    my @circulation_mandatory_keys = qw (type branch borrowernumber itemnumber ccode itemtype);
93
    my @accounts_mandatory_keys = qw (type branch borrowernumber amount);
94
95
    my @mandatory_keys = ();
96
    if (! exists $params->{type} or ! defined $params->{type}) {
97
        croak ("UpdateStats does not received type param");
98
    }
99
    if (grep ($_ eq $params->{type}, @allowed_circulation_types  )) {
100
        @mandatory_keys = @circulation_mandatory_keys;
101
    } elsif (grep ($_ eq $params->{type}, @allowed_accounts_types )) {
102
        @mandatory_keys = @accounts_mandatory_keys;
103
    } else {
104
        croak ("UpdateStats received forbidden type param: ".$params->{type});
105
    }
106
    my @missing_params = ();
107
    for my $mykey (@mandatory_keys ) {
108
        push @missing_params, $mykey if !grep (/^$mykey/, keys $params);
109
    }
110
    if (scalar @missing_params > 0 ) {
111
        croak ("UpdateStats does not received mandatory param(s): ".join (", ",@missing_params ));
112
    }
113
    my @invalid_params = ();
114
    for my $myparam (keys $params ) {
115
        push @invalid_params, $myparam unless grep (/^$myparam$/, @allowed_keys);
116
    }
117
    if (scalar @invalid_params > 0 ) {
118
        croak ("UpdateStats received invalid param(s): ".join (", ",@invalid_params ));
119
    }
120
# get the parameters
121
    my $branch            = $params->{branch};
122
    my $type              = $params->{type};
123
    my $borrowernumber    = exists $params->{borrowernumber} ? $params->{borrowernumber} :'';
124
    my $itemnumber        = exists $params->{itemnumber}     ? $params->{itemnumber} :'';
125
    my $amount            = exists $params->{amount}         ? $params->{amount} :'';
126
    my $other             = exists $params->{other}          ? $params->{other} :'';
127
    my $itemtype          = exists $params->{itemtype}       ? $params->{itemtype} :'';
128
    my $accountno         = exists $params->{accountno}      ? $params->{accountno} :'';
129
    my $ccode             = exists $params->{ccode}          ? $params->{ccode} :'';
74
130
75
    #module to insert stats data into stats table
76
    my (
77
        $branch,         $type,
78
        $amount,   $other,          $itemnum,
79
        $itemtype, $borrowernumber, $accountno, $ccode
80
      )
81
      = @_;
82
    my $dbh = C4::Context->dbh;
131
    my $dbh = C4::Context->dbh;
83
    my $sth = $dbh->prepare(
132
    my $sth = $dbh->prepare(
84
        "INSERT INTO statistics
133
        "INSERT INTO statistics
85
        (datetime, branch, type, value,
134
        (datetime,
86
         other, itemnumber, itemtype, borrowernumber, proccode, ccode)
135
         branch,          type,        value,
136
         other,           itemnumber,  itemtype,
137
         borrowernumber,  proccode,    ccode)
87
         VALUES (now(),?,?,?,?,?,?,?,?,?)"
138
         VALUES (now(),?,?,?,?,?,?,?,?,?)"
88
    );
139
    );
89
    $sth->execute(
140
    $sth->execute(
90
        $branch,    $type,    $amount,
141
        $branch,         $type,        $amount,
91
        $other,     $itemnum, $itemtype, $borrowernumber,
142
        $other,          $itemnumber,  $itemtype,
92
		$accountno, $ccode
143
        $borrowernumber, $accountno,   $ccode
93
    );
144
    );
94
}
145
}
95
146
96
# Otherwise, it'd need a POD.
147
=head2 TotalPaid
148
149
  @total = &TotalPaid ( $time, [$time2], [$spreadsheet ]);
150
151
Returns an array containing the payments and writeoffs made between two dates
152
C<$time> and C<$time2>, or on a specific one, or from C<$time> onwards.
153
154
C<$time> param is mandatory.
155
If C<$time> eq 'today', returns are limited to the current day
156
If C<$time2> eq '', results are returned from C<$time> onwards.
157
If C<$time2> is undef, returns are limited to C<$time>
158
C<$spreadsheet> param is optional and controls the sorting of the results.
159
160
Returns undef if no param is given
161
162
=cut
163
97
sub TotalPaid {
164
sub TotalPaid {
98
    my ( $time, $time2, $spreadsheet ) = @_;
165
    my ( $time, $time2, $spreadsheet ) = @_;
166
    return () unless (defined $time);
99
    $time2 = $time unless $time2;
167
    $time2 = $time unless $time2;
100
    my $dbh   = C4::Context->dbh;
168
    my $dbh   = C4::Context->dbh;
101
    my $query = "SELECT * FROM statistics 
169
    my $query = "SELECT * FROM statistics 
102
  LEFT JOIN borrowers ON statistics.borrowernumber= borrowers.borrowernumber
170
  LEFT JOIN borrowers ON statistics.borrowernumber= borrowers.borrowernumber
103
  WHERE (statistics.type='payment' OR statistics.type='writeoff') ";
171
  WHERE (statistics.type='payment' OR statistics.type='writeoff') ";
104
    if ( $time eq 'today' ) {
172
    if ( $time eq 'today' ) {
173
# FIXME wrong condition. Now() will not get all the payments of the day but of a specific timestamp
105
        $query .= " AND datetime = now()";
174
        $query .= " AND datetime = now()";
106
    } else {
175
    } else {
107
        $query .= " AND datetime > '$time'";    # FIXME: use placeholders
176
        $query .= " AND datetime > '$time'";    # FIXME: use placeholders
Lines 109-114 sub TotalPaid { Link Here
109
    if ( $time2 ne '' ) {
178
    if ( $time2 ne '' ) {
110
        $query .= " AND datetime < '$time2'";   # FIXME: use placeholders
179
        $query .= " AND datetime < '$time2'";   # FIXME: use placeholders
111
    }
180
    }
181
# FIXME if $time2 is undef, query will be "AND datetime > $time AND AND datetime < $time"
182
# Operators should probably be <= and >=
112
    if ($spreadsheet) {
183
    if ($spreadsheet) {
113
        $query .= " ORDER BY branch, type";
184
        $query .= " ORDER BY branch, type";
114
    }
185
    }
(-)a/t/db_dependent/Stats.t (-1 / +133 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
use Modern::Perl;
4
use C4::Stats;
5
6
use Test::More tests => 17;
7
8
BEGIN {
9
    use_ok('C4::Stats');
10
}
11
can_ok(
12
    'C4::Stats',
13
    qw(UpdateStats
14
    TotalPaid
15
      )
16
);
17
18
#Start transaction
19
my $dbh = C4::Context->dbh;
20
$dbh->{RaiseError} = 1;
21
$dbh->{AutoCommit} = 0;
22
23
#
24
# Test UpdateStats
25
#
26
27
is (UpdateStats () ,undef, "UpdateStats returns undef if no params");
28
29
my $params = {
30
              branch => "BRA",
31
              itemnumber => 31,
32
              borrowernumber => 5,
33
              amount =>5.1,
34
              other => "bla",
35
              itemtype => "BK",
36
              accountno => 51,
37
              ccode => "CODE",
38
};
39
my $return_error;
40
41
# returns undef and croaks if type is not allowed
42
$params -> {type} = "bla";
43
eval {UpdateStats($params)};
44
$return_error = $@;
45
isnt ($return_error,'',"UpdateStats returns undef and croaks if type is not allowed");
46
47
delete $params->{type};
48
# returns undef and croaks if type is missing
49
eval {UpdateStats($params)};
50
$return_error = $@;
51
isnt ($return_error,'',"UpdateStats returns undef and croaks if no type given");
52
53
$params -> {type} = undef;
54
# returns undef and croaks if type is undef
55
eval {UpdateStats($params)};
56
$return_error = $@;
57
isnt ($return_error,'',"UpdateStats returns undef and croaks if type is undef");
58
59
# returns undef and croaks if mandatory params are missing
60
my @allowed_circulation_types = qw (renew issue localuse return);
61
my @allowed_accounts_types = qw (writeoff payment);
62
my @circulation_mandatory_keys = qw (branch borrowernumber itemnumber ccode itemtype); #don't check type here
63
my @accounts_mandatory_keys = qw (branch borrowernumber amount); #don't check type here
64
65
my @missing_errors = ();
66
foreach my $key (@circulation_mandatory_keys) {
67
    my $value = $params->{$key};
68
    delete $params->{$key};
69
    foreach my $type (@allowed_circulation_types) {
70
        $params->{type} = $type;
71
        eval {UpdateStats($params)};
72
        $return_error = $@;
73
        push @missing_errors, "key:$key for type:$type" unless $return_error;
74
    }
75
    $params->{$key} = $value;
76
}
77
foreach my $key (@accounts_mandatory_keys) {
78
    my $value = $params->{$key};
79
    delete $params->{$key};
80
    foreach my $type (@allowed_accounts_types) {
81
        $params->{type} = $type;
82
        eval {UpdateStats($params)};
83
        $return_error = $@;
84
        push @missing_errors, "key:$key for type:$type" unless $return_error;
85
    }
86
    $params->{$key} = $value;
87
88
}
89
is (join (", ", @missing_errors),'',"UpdateStats returns undef and croaks if mandatory params are missing");
90
91
# returns undef and croaks if forbidden params are given
92
$params -> {type} = "return";
93
$params -> {newparam} = "true";
94
eval {UpdateStats($params)};
95
$return_error = $@;
96
isnt ($return_error,'',"UpdateStats returns undef and croaks if a forbidden param is given");
97
delete $params->{newparam};
98
99
# save the params in the right database fields
100
$dbh->do(q|DELETE FROM statistics|);
101
$params = {
102
              branch => "BRA",
103
              itemnumber => 31,
104
              borrowernumber => 5,
105
              amount =>5.1,
106
              other => "bla",
107
              itemtype => "BK",
108
              accountno => 51,
109
              ccode => "CODE",
110
              type => "return"
111
};
112
UpdateStats ($params);
113
my $sth = $dbh->prepare("SELECT * FROM statistics");
114
$sth->execute();
115
my $line = ${ $sth->fetchall_arrayref( {} ) }[0];
116
is ($params-> {branch},         $line->{branch},         "UpdateStats save branch param in branch field of statistics table");
117
is ($params-> {type},           $line->{type},           "UpdateStats save type param in type field of statistics table");
118
is ($params-> {borrowernumber}, $line->{borrowernumber}, "UpdateStats save borrowernumber param in borrowernumber field of statistics table");
119
cmp_ok($params-> {amount},'==', $line->{value},          "UpdateStats save amount param in value field of statistics table");
120
is ($params-> {other},          $line->{other},          "UpdateStats save other param in other field of statistics table");
121
is ($params-> {itemtype},       $line->{itemtype},       "UpdateStats save itemtype param in itemtype field of statistics table");
122
is ($params-> {accountno},      $line->{proccode},       "UpdateStats save accountno param in proccode field of statistics table");
123
is ($params-> {ccode},          $line->{ccode},          "UpdateStats save ccode param in ccode field of statistics table");
124
125
#
126
# Test TotalPaid
127
#
128
129
is (TotalPaid (),undef,"TotalPaid returns undef if no params are given");
130
# More tests to write!
131
132
#End transaction
133
$dbh->rollback;

Return to bug 11230