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

(-)a/C4/Circulation.pm (-9 / +23 lines)
Lines 1935-1952 sub AddReturn { Link Here
1935
1935
1936
                if ( C4::Context->preference('finesMode') eq 'production' ) {
1936
                if ( C4::Context->preference('finesMode') eq 'production' ) {
1937
                    if ( $amount > 0 ) {
1937
                    if ( $amount > 0 ) {
1938
                        C4::Overdues::UpdateFine( $issue->{itemnumber},
1938
                        C4::Overdues::UpdateFine(
1939
                            $issue->{borrowernumber},
1939
                            {
1940
                            $amount, $type, output_pref($datedue) );
1940
                                issue_id       => $issue->{issue_id},
1941
                                itemnumber     => $issue->{itemnumber},
1942
                                borrowernumber => $issue->{borrowernumber},
1943
                                amount         => $amount,
1944
                                type           => $type,
1945
                                due            => output_pref($datedue),
1946
                            }
1947
                        );
1941
                    }
1948
                    }
1942
                    elsif ($return_date) {
1949
                    elsif ($return_date) {
1943
1950
1944
                       # Backdated returns may have fines that shouldn't exist,
1951
                        # Backdated returns may have fines that shouldn't exist,
1945
                       # so in this case, we need to drop those fines to 0
1952
                        # so in this case, we need to drop those fines to 0
1946
1953
1947
                        C4::Overdues::UpdateFine( $issue->{itemnumber},
1954
                        C4::Overdues::UpdateFine(
1948
                            $issue->{borrowernumber},
1955
                            {
1949
                            0, $type, output_pref($datedue) );
1956
                                issue_id       => $issue->{issue_id},
1957
                                itemnumber     => $issue->{itemnumber},
1958
                                borrowernumber => $issue->{borrowernumber},
1959
                                amount         => 0,
1960
                                type           => $type,
1961
                                due            => output_pref($datedue),
1962
                            }
1963
                        );
1950
                    }
1964
                    }
1951
                }
1965
                }
1952
            }
1966
            }
(-)a/C4/Overdues.pm (-40 / +61 lines)
Lines 26-31 use Date::Manip qw/UnixDate/; Link Here
26
use List::MoreUtils qw( uniq );
26
use List::MoreUtils qw( uniq );
27
use POSIX qw( floor ceil );
27
use POSIX qw( floor ceil );
28
use Locale::Currency::Format 1.28;
28
use Locale::Currency::Format 1.28;
29
use Carp;
29
30
30
use C4::Circulation;
31
use C4::Circulation;
31
use C4::Context;
32
use C4::Context;
Lines 34-39 use C4::Log; # logaction Link Here
34
use C4::Debug;
35
use C4::Debug;
35
use C4::Budgets qw(GetCurrency);
36
use C4::Budgets qw(GetCurrency);
36
use Koha::DateUtils;
37
use Koha::DateUtils;
38
use Koha::Account::Line;
39
use Koha::Account::Lines;
37
40
38
use vars qw($VERSION @ISA @EXPORT);
41
use vars qw($VERSION @ISA @EXPORT);
39
42
Lines 471-477 sub GetIssuesIteminfo { Link Here
471
474
472
=head2 UpdateFine
475
=head2 UpdateFine
473
476
474
    &UpdateFine($itemnumber, $borrowernumber, $amount, $type, $description);
477
    &UpdateFine({ issue_id => $issue_id, itemnumber => $itemnumber, borrwernumber => $borrowernumber, amount => $amount, type => $type, $due => $date_due });
475
478
476
(Note: the following is mostly conjecture and guesswork.)
479
(Note: the following is mostly conjecture and guesswork.)
477
480
Lines 486-493 C<$amount> is the current amount owed by the patron. Link Here
486
489
487
C<$type> will be used in the description of the fine.
490
C<$type> will be used in the description of the fine.
488
491
489
C<$description> is a string that must be present in the description of
492
C<$due> is the due date formatted to the currently specified date format
490
the fine. I think this is expected to be a date in DD/MM/YYYY format.
491
493
492
C<&UpdateFine> looks up the amount currently owed on the given item
494
C<&UpdateFine> looks up the amount currently owed on the given item
493
and sets it to C<$amount>, creating, if necessary, a new entry in the
495
and sets it to C<$amount>, creating, if necessary, a new entry in the
Lines 504-511 accountlines table of the Koha database. Link Here
504
# Possible Answer: You might update a fine for a damaged item, *after* it is returned.
506
# Possible Answer: You might update a fine for a damaged item, *after* it is returned.
505
#
507
#
506
sub UpdateFine {
508
sub UpdateFine {
507
    my ( $itemnum, $borrowernumber, $amount, $type, $due ) = @_;
509
    my ($params) = @_;
508
	$debug and warn "UpdateFine($itemnum, $borrowernumber, $amount, " . ($type||'""') . ", $due) called";
510
511
    my $issue_id       = $params->{issue_id};
512
    my $itemnum        = $params->{itemnumber};
513
    my $borrowernumber = $params->{borrowernumber};
514
    my $amount         = $params->{amount};
515
    my $type           = $params->{type};
516
    my $due            = $params->{due};
517
518
    $debug and warn "UpdateFine({ itemnumber => $itemnum, borrowernumber => $borrowernumber, type => $type, due => $due, issue_id => $issue_id})";
519
520
    unless ( $issue_id ) {
521
        carp("No issue_id passed in!");
522
        return;
523
    }
524
509
    my $dbh = C4::Context->dbh;
525
    my $dbh = C4::Context->dbh;
510
    # FIXME - What exactly is this query supposed to do? It looks up an
526
    # FIXME - What exactly is this query supposed to do? It looks up an
511
    # entry in accountlines that matches the given item and borrower
527
    # entry in accountlines that matches the given item and borrower
Lines 536-545 sub UpdateFine { Link Here
536
    # - accumulate fines for other items
552
    # - accumulate fines for other items
537
    # so we can update $itemnum fine taking in account fine caps
553
    # so we can update $itemnum fine taking in account fine caps
538
    while (my $rec = $sth->fetchrow_hashref) {
554
    while (my $rec = $sth->fetchrow_hashref) {
539
        if ($rec->{itemnumber} == $itemnum && $rec->{description} =~ /$due_qr/) {
555
        if ( $rec->{issue_id} == $issue_id ) {
540
            if ($data) {
556
            if ($data) {
541
                warn "Not a unique accountlines record for item $itemnum borrower $borrowernumber";
557
                warn "Not a unique accountlines record for issue_id $issue_id";
542
            } else {
558
            }
559
            else {
543
                $data = $rec;
560
                $data = $rec;
544
                next;
561
                next;
545
            }
562
            }
Lines 557-591 sub UpdateFine { Link Here
557
    }
574
    }
558
575
559
    if ( $data ) {
576
    if ( $data ) {
560
577
        # we're updating an existing fine.  Only modify if amount changed
561
		# we're updating an existing fine.  Only modify if amount changed
562
        # Note that in the current implementation, you cannot pay against an accruing fine
578
        # Note that in the current implementation, you cannot pay against an accruing fine
563
        # (i.e. , of accounttype 'FU').  Doing so will break accrual.
579
        # (i.e. , of accounttype 'FU').  Doing so will break accrual.
564
    	if ( $data->{'amount'} != $amount ) {
580
        if ( $data->{'amount'} != $amount ) {
581
            my $accountline = Koha::Account::Lines->find( $data->{accountlines_id} );
565
            my $diff = $amount - $data->{'amount'};
582
            my $diff = $amount - $data->{'amount'};
566
	    #3341: diff could be positive or negative!
583
567
            my $out  = $data->{'amountoutstanding'} + $diff;
584
            #3341: diff could be positive or negative!
568
            my $query = "
585
            my $out   = $data->{'amountoutstanding'} + $diff;
569
                UPDATE accountlines
586
570
				SET date=now(), amount=?, amountoutstanding=?,
587
            $accountline->set(
571
					lastincrement=?, accounttype='FU'
588
                {
572
	  			WHERE borrowernumber=?
589
                    date          => dt_from_string(),
573
				AND   itemnumber=?
590
                    amount        => $amount,
574
				AND   accounttype IN ('FU','O')
591
                    outstanding   => $out,
575
				AND   description LIKE ?
592
                    lastincrement => $diff,
576
				LIMIT 1 ";
593
                    accounttype   => 'FU',
577
            my $sth2 = $dbh->prepare($query);
594
                }
578
			# FIXME: BOGUS query cannot ensure uniqueness w/ LIKE %x% !!!
595
            )->store();
579
			# 		LIMIT 1 added to prevent multiple affected lines
596
580
			# FIXME: accountlines table needs unique key!! Possibly a combo of borrowernumber and accountline.  
597
            # FIXME: BOGUS query cannot ensure uniqueness w/ LIKE %x% !!!
581
			# 		But actually, we should just have a regular autoincrementing PK and forget accountline,
598
            # 		LIMIT 1 added to prevent multiple affected lines
582
			# 		including the bogus getnextaccountno function (doesn't prevent conflict on simultaneous ops).
599
            # FIXME: accountlines table needs unique key!! Possibly a combo of borrowernumber and accountline.
583
			# FIXME: Why only 2 account types here?
600
            # 		But actually, we should just have a regular autoincrementing PK and forget accountline,
584
			$debug and print STDERR "UpdateFine query: $query\n" .
601
            # 		including the bogus getnextaccountno function (doesn't prevent conflict on simultaneous ops).
585
				"w/ args: $amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, \"\%$due\%\"\n";
602
            # FIXME: Why only 2 account types here?
586
            $sth2->execute($amount, $out, $diff, $data->{'borrowernumber'}, $data->{'itemnumber'}, "%$due%");
587
        } else {
588
            #      print "no update needed $data->{'amount'}"
589
        }
603
        }
590
    } else {
604
    } else {
591
        if ( $amount ) { # Don't add new fines with an amount of 0
605
        if ( $amount ) { # Don't add new fines with an amount of 0
Lines 599-610 sub UpdateFine { Link Here
599
613
600
            my $desc = ( $type ? "$type " : '' ) . "$title $due";    # FIXEDME, avoid whitespace prefix on empty $type
614
            my $desc = ( $type ? "$type " : '' ) . "$title $due";    # FIXEDME, avoid whitespace prefix on empty $type
601
615
602
            my $query = "INSERT INTO accountlines
616
            my $accountline = Koha::Account::Line->new(
603
                         (borrowernumber,itemnumber,date,amount,description,accounttype,amountoutstanding,lastincrement,accountno)
617
                {
604
                         VALUES (?,?,now(),?,?,'FU',?,?,?)";
618
                    borrowernumber    => $borrowernumber,
605
            my $sth2 = $dbh->prepare($query);
619
                    itemnumber        => $itemnum,
606
            $debug and print STDERR "UpdateFine query: $query\nw/ args: $borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno\n";
620
                    date              => dt_from_string(),
607
            $sth2->execute( $borrowernumber, $itemnum, $amount, $desc, $amount, $amount, $nextaccntno );
621
                    amount            => $amount,
622
                    description       => $desc,
623
                    accounttype       => 'FU',
624
                    amountoutstanding => $amount,
625
                    lastincrement     => $amount,
626
                    accountno         => $nextaccntno,
627
                }
628
            )->store();
608
        }
629
        }
609
    }
630
    }
610
    # logging action
631
    # logging action
(-)a/Koha/Account/Line.pm (+44 lines)
Line 0 Link Here
1
package Koha::Account::Line;
2
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it under the
6
# terms of the GNU General Public License as published by the Free Software
7
# Foundation; either version 3 of the License, or (at your option) any later
8
# version.
9
#
10
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
11
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13
#
14
# You should have received a copy of the GNU General Public License along
15
# with Koha; if not, write to the Free Software Foundation, Inc.,
16
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
17
18
use Modern::Perl;
19
20
use Carp;
21
22
use Koha::Database;
23
24
use base qw(Koha::Object);
25
26
=head1 NAME
27
28
Koha::Account::Lines - Koha accountline Object class
29
30
=head1 API
31
32
=head2 Class Methods
33
34
=cut
35
36
=head3 type
37
38
=cut
39
40
sub type {
41
    return 'Accountline';
42
}
43
44
1;
(-)a/Koha/Account/Lines.pm (+51 lines)
Line 0 Link Here
1
package Koha::Account::Lines;
2
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it under the
6
# terms of the GNU General Public License as published by the Free Software
7
# Foundation; either version 3 of the License, or (at your option) any later
8
# version.
9
#
10
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
11
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13
#
14
# You should have received a copy of the GNU General Public License along
15
# with Koha; if not, write to the Free Software Foundation, Inc.,
16
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
17
18
use Modern::Perl;
19
20
use Carp;
21
22
use Koha::Database;
23
24
use Koha::Account::Line;
25
26
use base qw(Koha::Objects);
27
28
=head1 NAME
29
30
Koha::Cities - Koha City Object set class
31
Koha::Account::Lines - Koha Account Line Object set class
32
33
=head1 API
34
35
=head2 Class Methods
36
37
=cut
38
39
=head3 type
40
41
=cut
42
43
sub type {
44
    return 'Accountline';
45
}
46
47
sub object_class {
48
    return 'Koha::Account::Line';
49
}
50
51
1;
(-)a/installer/data/mysql/atomicupdate/bug_15334.sql (+1 lines)
Line 0 Link Here
1
ALTER TABLE accountlines ADD issue_id INT(11) NULL DEFAULT NULL AFTER accountlines_id;
(-)a/installer/data/mysql/kohastructure.sql (+1 lines)
Lines 2765-2770 CREATE TABLE `messages` ( -- circulation messages left via the patron's check ou Link Here
2765
DROP TABLE IF EXISTS `accountlines`;
2765
DROP TABLE IF EXISTS `accountlines`;
2766
CREATE TABLE `accountlines` (
2766
CREATE TABLE `accountlines` (
2767
  `accountlines_id` int(11) NOT NULL AUTO_INCREMENT,
2767
  `accountlines_id` int(11) NOT NULL AUTO_INCREMENT,
2768
  `issue_id` int(11) NULL DEFAULT NULL,
2768
  `borrowernumber` int(11) NOT NULL default 0,
2769
  `borrowernumber` int(11) NOT NULL default 0,
2769
  `accountno` smallint(6) NOT NULL default 0,
2770
  `accountno` smallint(6) NOT NULL default 0,
2770
  `itemnumber` int(11) default NULL,
2771
  `itemnumber` int(11) default NULL,
(-)a/misc/cronjobs/fines.pl (-3 / +8 lines)
Lines 132-140 for my $overdue ( @{$overdues} ) { Link Here
132
    if ( $mode eq 'production' && !$is_holiday{$branchcode} ) {
132
    if ( $mode eq 'production' && !$is_holiday{$branchcode} ) {
133
        if ( $amount > 0 ) {
133
        if ( $amount > 0 ) {
134
            UpdateFine(
134
            UpdateFine(
135
                $overdue->{itemnumber},
135
                {
136
                $overdue->{borrowernumber},
136
                    issue_id       => $overdue->{issue_id},
137
                $amount, $type, output_pref($datedue)
137
                    itemnumber     => $overdue->{itemnumber},
138
                    borrowernumber => $overdue->{borrowernumber},
139
                    amount         => $amount,
140
                    type           => $type,
141
                    due            => output_pref($datedue),
142
                }
138
            );
143
            );
139
        }
144
        }
140
    }
145
    }
(-)a/t/db_dependent/Circulation.t (-8 / +30 lines)
Lines 469-476 C4::Context->dbh->do("DELETE FROM accountlines"); Link Here
469
        $biblionumber
469
        $biblionumber
470
    );
470
    );
471
471
472
    AddIssue( $renewing_borrower, $barcode4, undef, undef, undef, undef,
472
    $issue = AddIssue( $renewing_borrower, $barcode4, undef, undef, undef, undef, { auto_renew => 1 } );
473
        { auto_renew => 1 } );
474
    ( $renewokay, $error ) =
473
    ( $renewokay, $error ) =
475
      CanBookBeRenewed( $renewing_borrowernumber, $itemnumber4 );
474
      CanBookBeRenewed( $renewing_borrowernumber, $itemnumber4 );
476
    is( $renewokay, 0, 'Bug 14101: Cannot renew, renewal is automatic and premature' );
475
    is( $renewokay, 0, 'Bug 14101: Cannot renew, renewal is automatic and premature' );
Lines 545-552 C4::Context->dbh->do("DELETE FROM accountlines"); Link Here
545
    C4::Context->set_preference('WhenLostForgiveFine','1');
544
    C4::Context->set_preference('WhenLostForgiveFine','1');
546
    C4::Context->set_preference('WhenLostChargeReplacementFee','1');
545
    C4::Context->set_preference('WhenLostChargeReplacementFee','1');
547
546
548
    C4::Overdues::UpdateFine( $itemnumber, $renewing_borrower->{borrowernumber},
547
    C4::Overdues::UpdateFine(
549
        15.00, q{}, Koha::DateUtils::output_pref($datedue) );
548
        {
549
            issue_id       => $issue->id(),
550
            itemnumber     => $itemnumber,
551
            borrowernumber => $renewing_borrower->{borrowernumber},
552
            amount         => 15.00,
553
            type           => q{},
554
            due            => Koha::DateUtils::output_pref($datedue)
555
        }
556
    );
550
557
551
    LostItem( $itemnumber, 1 );
558
    LostItem( $itemnumber, 1 );
552
559
Lines 565-572 C4::Context->dbh->do("DELETE FROM accountlines"); Link Here
565
    C4::Context->set_preference('WhenLostForgiveFine','0');
572
    C4::Context->set_preference('WhenLostForgiveFine','0');
566
    C4::Context->set_preference('WhenLostChargeReplacementFee','0');
573
    C4::Context->set_preference('WhenLostChargeReplacementFee','0');
567
574
568
    C4::Overdues::UpdateFine( $itemnumber2, $renewing_borrower->{borrowernumber},
575
    C4::Overdues::UpdateFine(
569
        15.00, q{}, Koha::DateUtils::output_pref($datedue) );
576
        {
577
            issue_id       => $issue2->id(),
578
            itemnumber     => $itemnumber2,
579
            borrowernumber => $renewing_borrower->{borrowernumber},
580
            amount         => 15.00,
581
            type           => q{},
582
            due            => Koha::DateUtils::output_pref($datedue)
583
        }
584
    );
570
585
571
    LostItem( $itemnumber2, 0 );
586
    LostItem( $itemnumber2, 0 );
572
587
Lines 710-716 C4::Context->dbh->do("DELETE FROM accountlines"); Link Here
710
725
711
    my $borrowernumber = AddMember(%a_borrower_data);
726
    my $borrowernumber = AddMember(%a_borrower_data);
712
727
713
    UpdateFine( $itemnumber, $borrowernumber, 0 );
728
    my $issue = AddIssue( GetMember( borrowernumber => $borrowernumber ), $barcode );
729
    UpdateFine(
730
        {
731
            issue_id       => $issue->id(),
732
            itemnumber     => $itemnumber,
733
            borrowernumber => $borrowernumber,
734
            amount         => 0
735
        }
736
    );
714
737
715
    my $hr = $dbh->selectrow_hashref(q{SELECT COUNT(*) AS count FROM accountlines WHERE borrowernumber = ? AND itemnumber = ?}, undef, $borrowernumber, $itemnumber );
738
    my $hr = $dbh->selectrow_hashref(q{SELECT COUNT(*) AS count FROM accountlines WHERE borrowernumber = ? AND itemnumber = ?}, undef, $borrowernumber, $itemnumber );
716
    my $count = $hr->{count};
739
    my $count = $hr->{count};
717
- 

Return to bug 15675