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

(-)a/C4/Accounts.pm (-10 / +34 lines)
Lines 155-161 sub recordpayment { Link Here
155
    $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, $paytype, 0 - $amountleft, $manager_id );
155
    $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, $paytype, 0 - $amountleft, $manager_id );
156
    $usth->finish;
156
    $usth->finish;
157
157
158
    UpdateStats( $branch, 'payment', $data, '', '', '', $borrowernumber, $nextaccntno );
158
    UpdateStats({
159
                branch => $branch,
160
                type =>'payment',
161
                amount => $data,
162
                borrowernumber => $borrowernumber,
163
                accountno => $nextaccntno }
164
    );
159
165
160
    if ( C4::Context->preference("FinesLog") ) {
166
    if ( C4::Context->preference("FinesLog") ) {
161
        $accdata->{'amountoutstanding_new'} = $newamtos;
167
        $accdata->{'amountoutstanding_new'} = $newamtos;
Lines 266-277 sub makepayment { Link Here
266
        }));
272
        }));
267
    }
273
    }
268
274
269
275
    UpdateStats({
270
    # FIXME - The second argument to &UpdateStats is supposed to be the
276
                branch => $user,
271
    # branch code.
277
                type => 'payment',
272
    # UpdateStats is now being passed $accountno too. MTJ
278
                amount => $amount,
273
    UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber,
279
                borrowernumber => $borrowernumber,
274
        $accountno );
280
                accountno => $accountno}
281
    );
275
282
276
    #check to see what accounttype
283
    #check to see what accounttype
277
    if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
284
    if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
Lines 648-654 sub recordpayment_selectaccts { Link Here
648
    '(borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding,manager_id,note) ' .
655
    '(borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding,manager_id,note) ' .
649
    q|VALUES (?,?,now(),?,'','Pay',?,?,?)|;
656
    q|VALUES (?,?,now(),?,'','Pay',?,?,?)|;
650
    $dbh->do($sql,{},$borrowernumber, $nextaccntno, 0 - $amount, 0 - $amountleft, $manager_id, $note );
657
    $dbh->do($sql,{},$borrowernumber, $nextaccntno, 0 - $amount, 0 - $amountleft, $manager_id, $note );
651
    UpdateStats( $branch, 'payment', $amount, '', '', '', $borrowernumber, $nextaccntno );
658
    UpdateStats({
659
                branch => $branch,
660
                type => 'payment',
661
                amount => $amount,
662
                borrowernumber => $borrowernumber,
663
                accountno => $nextaccntno}
664
    );
652
665
653
    if ( C4::Context->preference("FinesLog") ) {
666
    if ( C4::Context->preference("FinesLog") ) {
654
        logaction("FINES", 'CREATE',$borrowernumber,Dumper({
667
        logaction("FINES", 'CREATE',$borrowernumber,Dumper({
Lines 709-715 sub makepartialpayment { Link Here
709
    $dbh->do(  $insert, undef, $borrowernumber, $nextaccntno, $amount,
722
    $dbh->do(  $insert, undef, $borrowernumber, $nextaccntno, $amount,
710
        "Payment, thanks - $user", 'Pay', $data->{'itemnumber'}, $manager_id, $payment_note);
723
        "Payment, thanks - $user", 'Pay', $data->{'itemnumber'}, $manager_id, $payment_note);
711
724
712
    UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber, $accountno );
725
    UpdateStats({
726
                branch => $user,
727
                type => 'payment',
728
                amount => $amount,
729
                borrowernumber => $borrowernumber,
730
                accountno => $accountno}
731
    );
713
732
714
    if ( C4::Context->preference("FinesLog") ) {
733
    if ( C4::Context->preference("FinesLog") ) {
715
        logaction("FINES", 'CREATE',$borrowernumber,Dumper({
734
        logaction("FINES", 'CREATE',$borrowernumber,Dumper({
Lines 793-799 sub WriteOffFee { Link Here
793
        }));
812
        }));
794
    }
813
    }
795
814
796
    UpdateStats( $branch, 'writeoff', $amount, q{}, q{}, q{}, $borrowernumber );
815
    UpdateStats({
816
                branch => $branch,
817
                type => 'writeoff',
818
                amount => $amount,
819
                borrowernumber => $borrowernumber}
820
    );
797
821
798
}
822
}
799
823
(-)a/C4/Circulation.pm (-14 / +34 lines)
Lines 740-746 sub CanBookBeIssued { Link Here
740
    #
740
    #
741
    if ( $borrower->{'category_type'} eq 'X' && (  $item->{barcode}  )) { 
741
    if ( $borrower->{'category_type'} eq 'X' && (  $item->{barcode}  )) { 
742
    	# stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1  .
742
    	# stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1  .
743
        &UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'}, undef, $item->{'ccode'});
743
        &UpdateStats({
744
                     branch => C4::Context->userenv->{'branch'},
745
                     type => 'localuse',
746
                     itemnumber => $item->{'itemnumber'},
747
                     itemtype => $item->{'itemtype'},
748
                     borrowernumber => $borrower->{'borrowernumber'},
749
                     ccode => $item->{'ccode'}}
750
                    );
744
        ModDateLastSeen( $item->{'itemnumber'} );
751
        ModDateLastSeen( $item->{'itemnumber'} );
745
        return( { STATS => 1 }, {});
752
        return( { STATS => 1 }, {});
746
    }
753
    }
Lines 1299-1309 sub AddIssue { Link Here
1299
        }
1306
        }
1300
1307
1301
        # Record the fact that this book was issued.
1308
        # Record the fact that this book was issued.
1302
        &UpdateStats(
1309
        &UpdateStats({
1303
            C4::Context->userenv->{'branch'},
1310
                      branch => C4::Context->userenv->{'branch'},
1304
            'issue', $charge,
1311
                      type => 'issue',
1305
            ($sipmode ? "SIP-$sipmode" : ''), $item->{'itemnumber'},
1312
                      amount => $charge,
1306
            $item->{'itype'}, $borrower->{'borrowernumber'}, undef, $item->{'ccode'}
1313
                      other => ($sipmode ? "SIP-$sipmode" : ''),
1314
                      itemnumber => $item->{'itemnumber'},
1315
                      itemtype => $item->{'itype'},
1316
                      borrowernumber => $borrower->{'borrowernumber'},
1317
                      ccode => $item->{'ccode'}}
1307
        );
1318
        );
1308
1319
1309
        # Send a checkout slip.
1320
        # Send a checkout slip.
Lines 1721-1727 sub AddReturn { Link Here
1721
    my $biblio;
1732
    my $biblio;
1722
    my $doreturn       = 1;
1733
    my $doreturn       = 1;
1723
    my $validTransfert = 0;
1734
    my $validTransfert = 0;
1724
    my $stat_type = 'return';    
1735
    my $stat_type = 'return';
1725
1736
1726
    # get information on item
1737
    # get information on item
1727
    my $itemnumber = GetItemnumberFromBarcode( $barcode );
1738
    my $itemnumber = GetItemnumberFromBarcode( $barcode );
Lines 1937-1949 sub AddReturn { Link Here
1937
        $messages->{'ResFound'} = $resrec;
1948
        $messages->{'ResFound'} = $resrec;
1938
    }
1949
    }
1939
1950
1940
    # update stats?
1941
    # Record the fact that this book was returned.
1951
    # Record the fact that this book was returned.
1942
    UpdateStats(
1952
    # FIXME itemtype should record item level type, not bibliolevel type
1943
        $branch, $stat_type, '0', '',
1953
    UpdateStats({
1944
        $item->{'itemnumber'},
1954
                branch => $branch,
1945
        $biblio->{'itemtype'},
1955
                type => $stat_type,
1946
        $borrowernumber, undef, $item->{'ccode'}
1956
                itemnumber => $item->{'itemnumber'},
1957
                itemtype => $biblio->{'itemtype'},
1958
                borrowernumber => $borrowernumber,
1959
                ccode => $item->{'ccode'}}
1947
    );
1960
    );
1948
1961
1949
    # Send a check-in slip. # NOTE: borrower may be undef.  probably shouldn't try to send messages then.
1962
    # Send a check-in slip. # NOTE: borrower may be undef.  probably shouldn't try to send messages then.
Lines 2774-2780 sub AddRenewal { Link Here
2774
    }
2787
    }
2775
2788
2776
    # Log the renewal
2789
    # Log the renewal
2777
    UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber, undef, $item->{'ccode'});
2790
    UpdateStats({branch => $branch,
2791
                type => 'renew',
2792
                amount => $charge,
2793
                itemnumber => $itemnumber,
2794
                itemtype => $item->{itype},
2795
                borrowernumber => $borrowernumber,
2796
                ccode => $item->{'ccode'}}
2797
                );
2778
	return $datedue;
2798
	return $datedue;
2779
}
2799
}
2780
2800
(-)a/C4/Stats.pm (-27 / +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
    }
Lines 121-128 sub TotalPaid { Link Here
121
1;
192
1;
122
__END__
193
__END__
123
194
124
=back
125
126
=head1 AUTHOR
195
=head1 AUTHOR
127
196
128
Koha Development Team <http://koha-community.org/>
197
Koha Development Team <http://koha-community.org/>
(-)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