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

(-)a/C4/Circulation.pm (-9 / +23 lines)
Lines 1932-1949 sub AddReturn { Link Here
1932
1932
1933
                if ( C4::Context->preference('finesMode') eq 'production' ) {
1933
                if ( C4::Context->preference('finesMode') eq 'production' ) {
1934
                    if ( $amount > 0 ) {
1934
                    if ( $amount > 0 ) {
1935
                        C4::Overdues::UpdateFine( $issue->{itemnumber},
1935
                        C4::Overdues::UpdateFine(
1936
                            $issue->{borrowernumber},
1936
                            {
1937
                            $amount, $type, output_pref($datedue) );
1937
                                issue_id       => $issue->{issue_id},
1938
                                itemnumber     => $issue->{itemnumber},
1939
                                borrowernumber => $issue->{borrowernumber},
1940
                                amount         => $amount,
1941
                                type           => $type,
1942
                                due            => output_pref($datedue),
1943
                            }
1944
                        );
1938
                    }
1945
                    }
1939
                    elsif ($return_date) {
1946
                    elsif ($return_date) {
1940
1947
1941
                       # Backdated returns may have fines that shouldn't exist,
1948
                        # Backdated returns may have fines that shouldn't exist,
1942
                       # so in this case, we need to drop those fines to 0
1949
                        # so in this case, we need to drop those fines to 0
1943
1950
1944
                        C4::Overdues::UpdateFine( $issue->{itemnumber},
1951
                        C4::Overdues::UpdateFine(
1945
                            $issue->{borrowernumber},
1952
                            {
1946
                            0, $type, output_pref($datedue) );
1953
                                issue_id       => $issue->{issue_id},
1954
                                itemnumber     => $issue->{itemnumber},
1955
                                borrowernumber => $issue->{borrowernumber},
1956
                                amount         => 0,
1957
                                type           => $type,
1958
                                due            => output_pref($datedue),
1959
                            }
1960
                        );
1947
                    }
1961
                    }
1948
                }
1962
                }
1949
            }
1963
            }
(-)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 2747-2752 CREATE TABLE `messages` ( -- circulation messages left via the patron's check ou Link Here
2747
DROP TABLE IF EXISTS `accountlines`;
2747
DROP TABLE IF EXISTS `accountlines`;
2748
CREATE TABLE `accountlines` (
2748
CREATE TABLE `accountlines` (
2749
  `accountlines_id` int(11) NOT NULL AUTO_INCREMENT,
2749
  `accountlines_id` int(11) NOT NULL AUTO_INCREMENT,
2750
  `issue_id` int(11) NULL DEFAULT NULL,
2750
  `borrowernumber` int(11) NOT NULL default 0,
2751
  `borrowernumber` int(11) NOT NULL default 0,
2751
  `accountno` smallint(6) NOT NULL default 0,
2752
  `accountno` smallint(6) NOT NULL default 0,
2752
  `itemnumber` int(11) default NULL,
2753
  `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 (-7 / +30 lines)
Lines 467-473 C4::Context->dbh->do("DELETE FROM accountlines"); Link Here
467
        $biblionumber
467
        $biblionumber
468
    );
468
    );
469
469
470
    AddIssue( $renewing_borrower, $barcode4, undef, undef, undef, undef, { auto_renew => 1 } );
470
    $issue = AddIssue( $renewing_borrower, $barcode4, undef, undef, undef, undef, { auto_renew => 1 } );
471
    ( $renewokay, $error ) =
471
    ( $renewokay, $error ) =
472
      CanBookBeRenewed( $renewing_borrowernumber, $itemnumber4 );
472
      CanBookBeRenewed( $renewing_borrowernumber, $itemnumber4 );
473
    is( $renewokay, 0, 'Bug 14101: Cannot renew, renewal is automatic and premature' );
473
    is( $renewokay, 0, 'Bug 14101: Cannot renew, renewal is automatic and premature' );
Lines 527-534 C4::Context->dbh->do("DELETE FROM accountlines"); Link Here
527
    C4::Context->set_preference('WhenLostForgiveFine','1');
527
    C4::Context->set_preference('WhenLostForgiveFine','1');
528
    C4::Context->set_preference('WhenLostChargeReplacementFee','1');
528
    C4::Context->set_preference('WhenLostChargeReplacementFee','1');
529
529
530
    C4::Overdues::UpdateFine( $itemnumber, $renewing_borrower->{borrowernumber},
530
    C4::Overdues::UpdateFine(
531
        15.00, q{}, Koha::DateUtils::output_pref($datedue) );
531
        {
532
            issue_id       => $issue->id(),
533
            itemnumber     => $itemnumber,
534
            borrowernumber => $renewing_borrower->{borrowernumber},
535
            amount         => 15.00,
536
            type           => q{},
537
            due            => Koha::DateUtils::output_pref($datedue)
538
        }
539
    );
532
540
533
    LostItem( $itemnumber, 1 );
541
    LostItem( $itemnumber, 1 );
534
542
Lines 547-554 C4::Context->dbh->do("DELETE FROM accountlines"); Link Here
547
    C4::Context->set_preference('WhenLostForgiveFine','0');
555
    C4::Context->set_preference('WhenLostForgiveFine','0');
548
    C4::Context->set_preference('WhenLostChargeReplacementFee','0');
556
    C4::Context->set_preference('WhenLostChargeReplacementFee','0');
549
557
550
    C4::Overdues::UpdateFine( $itemnumber2, $renewing_borrower->{borrowernumber},
558
    C4::Overdues::UpdateFine(
551
        15.00, q{}, Koha::DateUtils::output_pref($datedue) );
559
        {
560
            issue_id       => $issue2->id(),
561
            itemnumber     => $itemnumber2,
562
            borrowernumber => $renewing_borrower->{borrowernumber},
563
            amount         => 15.00,
564
            type           => q{},
565
            due            => Koha::DateUtils::output_pref($datedue)
566
        }
567
    );
552
568
553
    LostItem( $itemnumber2, 0 );
569
    LostItem( $itemnumber2, 0 );
554
570
Lines 692-698 C4::Context->dbh->do("DELETE FROM accountlines"); Link Here
692
708
693
    my $borrowernumber = AddMember(%a_borrower_data);
709
    my $borrowernumber = AddMember(%a_borrower_data);
694
710
695
    UpdateFine( $itemnumber, $borrowernumber, 0 );
711
    my $issue = AddIssue( GetMember( borrowernumber => $borrowernumber ), $barcode );
712
    UpdateFine(
713
        {
714
            issue_id       => $issue->id(),
715
            itemnumber     => $itemnumber,
716
            borrowernumber => $borrowernumber,
717
            amount         => 0
718
        }
719
    );
696
720
697
    my $hr = $dbh->selectrow_hashref(q{SELECT COUNT(*) AS count FROM accountlines WHERE borrowernumber = ? AND itemnumber = ?}, undef, $borrowernumber, $itemnumber );
721
    my $hr = $dbh->selectrow_hashref(q{SELECT COUNT(*) AS count FROM accountlines WHERE borrowernumber = ? AND itemnumber = ?}, undef, $borrowernumber, $itemnumber );
698
    my $count = $hr->{count};
722
    my $count = $hr->{count};
699
- 

Return to bug 15675