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

(-)a/C4/Circulation.pm (-25 / +43 lines)
Lines 986-1014 sub CanBookBeIssued { Link Here
986
    }
986
    }
987
987
988
    ## CHECK AGE RESTRICTION
988
    ## CHECK AGE RESTRICTION
989
    # get $marker from preferences. Could be something like "FSK|PEGI|Alter|Age:"
989
    my $agerestriction  = $biblioitem->{'agerestriction'};
990
    my $markers         = C4::Context->preference('AgeRestrictionMarker');
990
    my ($restriction_age, $daysToAgeRestriction) = GetAgeRestriction( $agerestriction, $borrower );
991
    my $bibvalues       = $biblioitem->{'agerestriction'};
991
    if ( $daysToAgeRestriction && $daysToAgeRestriction > 0 ) {
992
    my $restriction_age = GetAgeRestriction( $bibvalues );
992
        if ( C4::Context->preference('AgeRestrictionOverride') ) {
993
993
            $needsconfirmation{AGE_RESTRICTION} = "$agerestriction";
994
    if ( $restriction_age > 0 ) {
994
        }
995
        if ( $borrower->{'dateofbirth'} ) {
995
        else {
996
            my @alloweddate = split /-/, $borrower->{'dateofbirth'};
996
            $issuingimpossible{AGE_RESTRICTION} = "$agerestriction";
997
            $alloweddate[0] += $restriction_age;
998
999
            #Prevent runime eror on leap year (invalid date)
1000
            if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
1001
                $alloweddate[2] = 28;
1002
            }
1003
1004
            if ( Date_to_Days(Today) < Date_to_Days(@alloweddate) - 1 ) {
1005
                if ( C4::Context->preference('AgeRestrictionOverride') ) {
1006
                    $needsconfirmation{AGE_RESTRICTION} = "$bibvalues";
1007
                }
1008
                else {
1009
                    $issuingimpossible{AGE_RESTRICTION} = "$bibvalues";
1010
                }
1011
            }
1012
        }
997
        }
1013
    }
998
    }
1014
999
Lines 3742-3749 sub IsItemIssued { Link Here
3742
    return $sth->fetchrow;
3727
    return $sth->fetchrow;
3743
}
3728
}
3744
3729
3730
=head2 GetAgeRestriction
3731
3732
  my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
3733
  my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
3734
3735
  if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as he is older or as old as the agerestriction }
3736
  if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
3737
3738
@PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
3739
@PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
3740
@RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
3741
         Negative days mean the borrower has gone past the age restriction age.
3742
3743
=cut
3744
3745
sub GetAgeRestriction {
3745
sub GetAgeRestriction {
3746
    my ($record_restrictions) = @_;
3746
    my ($record_restrictions, $borrower) = @_;
3747
    my $markers = C4::Context->preference('AgeRestrictionMarker');
3747
    my $markers = C4::Context->preference('AgeRestrictionMarker');
3748
3748
3749
    # Split $record_restrictions to something like FSK 16 or PEGI 6
3749
    # Split $record_restrictions to something like FSK 16 or PEGI 6
Lines 3777-3783 sub GetAgeRestriction { Link Here
3777
        last if ( $restriction_year > 0 );
3777
        last if ( $restriction_year > 0 );
3778
    }
3778
    }
3779
3779
3780
    return $restriction_year;
3780
    #Check if the borrower is age restricted for this material and for how long.
3781
    if ($restriction_year && $borrower) {
3782
        if ( $borrower->{'dateofbirth'} ) {
3783
            my @alloweddate = split /-/, $borrower->{'dateofbirth'};
3784
            $alloweddate[0] += $restriction_year;
3785
3786
            #Prevent runime eror on leap year (invalid date)
3787
            if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
3788
                $alloweddate[2] = 28;
3789
            }
3790
3791
            #Get how many days the borrower has to reach the age restriction
3792
            my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(Today);
3793
            #Negative days means the borrower went past the age restriction age
3794
            return ($restriction_year, $daysToAgeRestriction);
3795
        }
3796
    }
3797
3798
    return ($restriction_year);
3781
}
3799
}
3782
3800
3783
1;
3801
1;
(-)a/C4/Members.pm (+43 lines)
Lines 1749-1754 sub GetAge{ Link Here
1749
    return $age;
1749
    return $age;
1750
}    # sub get_age
1750
}    # sub get_age
1751
1751
1752
=head2 SetAge
1753
1754
  $borrower = C4::Members::SetAge($borrower, $datetimeduration);
1755
  $borrower = C4::Members::SetAge($borrower, '0015-12-10');
1756
  $borrower = C4::Members::SetAge($borrower, $datetimeduration, $datetime_reference);
1757
1758
  eval { $borrower = C4::Members::SetAge($borrower, '015-1-10'); };
1759
  if ($@) {print $@;} #Catch a bad ISO Date or kill your script!
1760
1761
This function sets the borrower's dateofbirth to match the given age.
1762
Optionally relative to the given $datetime_reference.
1763
1764
@PARAM1 koha.borrowers-object
1765
@PARAM2 DateTime::Duration-object as the desired age
1766
        OR a ISO 8601 Date. (To make the API more pleasant)
1767
@PARAM3 DateTime-object as the relative date, defaults to now().
1768
RETURNS The given borrower reference @PARAM1.
1769
DIES    If there was an error with the ISO Date handling.
1770
1771
=cut
1772
1773
#'
1774
sub SetAge{
1775
    my ( $borrower, $datetimeduration, $datetime_ref ) = @_;
1776
    $datetime_ref = DateTime->now() unless $datetime_ref;
1777
1778
    if ($datetimeduration && ref $datetimeduration ne 'DateTime::Duration') {
1779
        if ($datetimeduration =~ /^(\d{4})-(\d{2})-(\d{2})/) {
1780
            $datetimeduration = DateTime::Duration->new(years => $1, months => $2, days => $3);
1781
        }
1782
        else {
1783
            die "C4::Members::SetAge($borrower, $datetimeduration), datetimeduration not a valid ISO 8601 Date!\n";
1784
        }
1785
    }
1786
1787
    my $new_datetime_ref = $datetime_ref->clone();
1788
    $new_datetime_ref->subtract_duration( $datetimeduration );
1789
1790
    $borrower->{dateofbirth} = $new_datetime_ref->ymd();
1791
1792
    return $borrower;
1793
}    # sub SetAge
1794
1752
=head2 GetCities
1795
=head2 GetCities
1753
1796
1754
  $cityarrayref = GetCities();
1797
  $cityarrayref = GetCities();
(-)a/t/Circulation/AgeRestrictionMarkers.t (-1 / +20 lines)
Lines 1-5 Link Here
1
#!/usr/bin/perl
2
1
use Modern::Perl;
3
use Modern::Perl;
2
use Test::More tests => 5;
4
use DateTime;
5
use Test::More tests => 10;
3
6
4
use t::lib::Mocks;
7
use t::lib::Mocks;
5
8
Lines 13-15 is ( C4::Circulation::GetAgeRestriction('PEGI16'), '16', 'PEGI16 returns 16' ); Link Here
13
is ( C4::Circulation::GetAgeRestriction('Age 16'), '16', 'Age 16 returns 16' );
16
is ( C4::Circulation::GetAgeRestriction('Age 16'), '16', 'Age 16 returns 16' );
14
is ( C4::Circulation::GetAgeRestriction('K16'), '16', 'K16 returns 16' );
17
is ( C4::Circulation::GetAgeRestriction('K16'), '16', 'K16 returns 16' );
15
18
19
20
##Testing age restriction for a borrower.
21
my $now = DateTime->now();
22
my $borrower = {};
23
C4::Members::SetAge( $borrower, '0015-00-00' );
24
25
my ($restriction_age, $daysToAgeRestriction) = C4::Circulation::GetAgeRestriction('FSK 16', $borrower);
26
is ( ($daysToAgeRestriction > 0), 1, 'FSK 16 blocked for a 15 year old' );
27
($restriction_age, $daysToAgeRestriction) = C4::Circulation::GetAgeRestriction('PEGI 15', $borrower);
28
is ( ($daysToAgeRestriction <= 0), 1, 'PEGI 15 allowed for a 15 year old' );
29
($restriction_age, $daysToAgeRestriction) = C4::Circulation::GetAgeRestriction('PEGI14', $borrower);
30
is ( ($daysToAgeRestriction <= 0), 1, 'PEGI14 allowed for a 15 year old' );
31
($restriction_age, $daysToAgeRestriction) = C4::Circulation::GetAgeRestriction('Age 10', $borrower);
32
is ( ($daysToAgeRestriction <= 0), 1, 'Age 10 allowed for a 15 year old' );
33
($restriction_age, $daysToAgeRestriction) = C4::Circulation::GetAgeRestriction('K18', $borrower);
34
is ( ($daysToAgeRestriction > 0), 1, 'K18 blocked for a 15 year old' );
(-)a/t/db_dependent/Members.t (-6 / +79 lines)
Lines 17-23 Link Here
17
17
18
use Modern::Perl;
18
use Modern::Perl;
19
19
20
use Test::More tests => 58;
20
use Test::More tests => 69;
21
use Test::MockModule;
21
use Test::MockModule;
22
use Data::Dumper;
22
use Data::Dumper;
23
use C4::Context;
23
use C4::Context;
Lines 82-87 my %data = ( Link Here
82
    userid => 'tomasito'
82
    userid => 'tomasito'
83
);
83
);
84
84
85
testAgeAccessors(\%data); #Age accessor tests don't touch the db so it is safe to run them with just the object.
86
85
my $addmem=AddMember(%data);
87
my $addmem=AddMember(%data);
86
ok($addmem, "AddMember()");
88
ok($addmem, "AddMember()");
87
89
Lines 196-206 C4::Context->clear_syspref_cache(); Link Here
196
$checkcardnum=C4::Members::checkcardnumber($IMPOSSIBLE_CARDNUMBER, "");
198
$checkcardnum=C4::Members::checkcardnumber($IMPOSSIBLE_CARDNUMBER, "");
197
is ($checkcardnum, "2", "Card number is too long");
199
is ($checkcardnum, "2", "Card number is too long");
198
200
199
my $age=GetAge("1992-08-14", "2011-01-19");
200
is ($age, "18", "Age correct");
201
201
202
$age=GetAge("2011-01-19", "1992-01-19");
203
is ($age, "-19", "Birthday In the Future");
204
202
205
C4::Context->set_preference( 'AutoEmailPrimaryAddress', 'OFF' );
203
C4::Context->set_preference( 'AutoEmailPrimaryAddress', 'OFF' );
206
C4::Context->clear_syspref_cache();
204
C4::Context->clear_syspref_cache();
Lines 343-346 sub _find_member { Link Here
343
    return $found;
341
    return $found;
344
}
342
}
345
343
344
### ------------------------------------- ###
345
### Testing GetAge() / SetAge() functions ###
346
### ------------------------------------- ###
347
#USES the package $member-variable to mock a koha.borrowers-object
348
sub testAgeAccessors {
349
    my ($member) = @_;
350
    my $original_dateofbirth = $member->{dateofbirth};
351
352
    ##Testing GetAge()
353
    my $age=GetAge("1992-08-14", "2011-01-19");
354
    is ($age, "18", "Age correct");
355
356
    $age=GetAge("2011-01-19", "1992-01-19");
357
    is ($age, "-19", "Birthday In the Future");
358
359
    ##Testing SetAge() for now()
360
    my $dt_now = DateTime->now();
361
    my $age = DateTime::Duration->new(years => 12, months => 6, days => 1);
362
    C4::Members::SetAge( $member, $age );
363
    $age = C4::Members::GetAge( $member->{dateofbirth} );
364
    is ($age, '12', "SetAge 12 years");
365
366
    $age = DateTime::Duration->new(years => 18, months => 12, days => 31);
367
    C4::Members::SetAge( $member, $age );
368
    $age = C4::Members::GetAge( $member->{dateofbirth} );
369
    is ($age, '19', "SetAge 18+1 years"); #This is a special case, where months=>12 and days=>31 constitute one full year, hence we get age 19 instead of 18.
370
371
    $age = DateTime::Duration->new(years => 18, months => 12, days => 30);
372
    C4::Members::SetAge( $member, $age );
373
    $age = C4::Members::GetAge( $member->{dateofbirth} );
374
    is ($age, '19', "SetAge 18 years");
375
376
    $age = DateTime::Duration->new(years => 0, months => 1, days => 1);
377
    C4::Members::SetAge( $member, $age );
378
    $age = C4::Members::GetAge( $member->{dateofbirth} );
379
    is ($age, '0', "SetAge 0 years");
380
381
    $age = '0018-12-31';
382
    C4::Members::SetAge( $member, $age );
383
    $age = C4::Members::GetAge( $member->{dateofbirth} );
384
    is ($age, '19', "SetAge ISO_Date 18+1 years"); #This is a special case, where months=>12 and days=>31 constitute one full year, hence we get age 19 instead of 18.
385
386
    $age = '0018-12-30';
387
    C4::Members::SetAge( $member, $age );
388
    $age = C4::Members::GetAge( $member->{dateofbirth} );
389
    is ($age, '19', "SetAge ISO_Date 18 years");
390
391
    $age = '18-1-1';
392
    eval { C4::Members::SetAge( $member, $age ); };
393
    is ((length $@ > 1), '1', "SetAge ISO_Date $age years FAILS");
394
395
    $age = '0018-01-01';
396
    eval { C4::Members::SetAge( $member, $age ); };
397
    is ((length $@ == 0), '1', "SetAge ISO_Date $age years succeeds");
398
399
    ##Testing SetAge() for relative_date
400
    my $relative_date = DateTime->new(year => 3010, month => 3, day => 15);
401
402
    $age = DateTime::Duration->new(years => 10, months => 3);
403
    C4::Members::SetAge( $member, $age, $relative_date );
404
    $age = C4::Members::GetAge( $member->{dateofbirth}, $relative_date->ymd() );
405
    is ($age, '10', "SetAge, 10 years and 3 months old person was born on ".$member->{dateofbirth}." if todays is ".$relative_date->ymd());
406
407
    $age = DateTime::Duration->new(years => 112, months => 1, days => 1);
408
    C4::Members::SetAge( $member, $age, $relative_date );
409
    $age = C4::Members::GetAge( $member->{dateofbirth}, $relative_date->ymd() );
410
    is ($age, '112', "SetAge, 112 years, 1 months and 1 days old person was born on ".$member->{dateofbirth}." if today is ".$relative_date->ymd());
411
412
    $age = '0112-01-01';
413
    C4::Members::SetAge( $member, $age, $relative_date );
414
    $age = C4::Members::GetAge( $member->{dateofbirth}, $relative_date->ymd() );
415
    is ($age, '112', "SetAge ISO_Date, 112 years, 1 months and 1 days old person was born on ".$member->{dateofbirth}." if today is ".$relative_date->ymd());
416
417
    $member->{dateofbirth} = $original_dateofbirth; #It is polite to revert made changes in the unit tests.
418
} #sub testAgeAccessors
419
346
1;
420
1;
347
- 

Return to bug 13106