=head2 GetAgeRestriction

  my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);

  my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);

  if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as he is older or as old as the agerestriction }

  if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }

@PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...

@PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)

@RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.

         Negative days mean the borrower has gone past the age restriction age.

=cut

=head2 SetAge

  $borrower = C4::Members::SetAge($borrower, $datetimeduration);

  $borrower = C4::Members::SetAge($borrower, '0015-12-10');

  $borrower = C4::Members::SetAge($borrower, $datetimeduration, $datetime_reference);

  eval { $borrower = C4::Members::SetAge($borrower, '015-1-10'); };

  if ($@) {print $@;} #Catch a bad ISO Date or kill your script!

This function sets the borrower's dateofbirth to match the given age.

Optionally relative to the given $datetime_reference.

@PARAM1 koha.borrowers-object

@PARAM2 DateTime::Duration-object as the desired age

        OR a ISO 8601 Date. (To make the API more pleasant)

@PARAM3 DateTime-object as the relative date, defaults to now().

RETURNS The given borrower reference @PARAM1.

DIES    If there was an error with the ISO Date handling.

=cut

#'

sub SetAge{

    my ( $borrower, $datetimeduration, $datetime_ref ) = @_;

    $datetime_ref = DateTime->now() unless $datetime_ref;

    if ($datetimeduration && ref $datetimeduration ne 'DateTime::Duration') {

        if ($datetimeduration =~ /^(\d{4})-(\d{2})-(\d{2})/) {

            $datetimeduration = DateTime::Duration->new(years => $1, months => $2, days => $3);

        }

        else {

            die "C4::Members::SetAge($borrower, $datetimeduration), datetimeduration not a valid ISO 8601 Date!\n";

        }

    }

    my $new_datetime_ref = $datetime_ref->clone();

    $new_datetime_ref->subtract_duration( $datetimeduration );

    $borrower->{dateofbirth} = $new_datetime_ref->ymd();

    return $borrower;

}    # sub SetAge

#!/usr/bin/perl

##Testing age restriction for a borrower.

my $now = DateTime->now();

my $borrower = {};

C4::Members::SetAge( $borrower, '0015-00-00' );

my ($restriction_age, $daysToAgeRestriction) = C4::Circulation::GetAgeRestriction('FSK 16', $borrower);

is ( ($daysToAgeRestriction > 0), 1, 'FSK 16 blocked for a 15 year old' );

($restriction_age, $daysToAgeRestriction) = C4::Circulation::GetAgeRestriction('PEGI 15', $borrower);

is ( ($daysToAgeRestriction <= 0), 1, 'PEGI 15 allowed for a 15 year old' );

($restriction_age, $daysToAgeRestriction) = C4::Circulation::GetAgeRestriction('PEGI14', $borrower);

is ( ($daysToAgeRestriction <= 0), 1, 'PEGI14 allowed for a 15 year old' );

($restriction_age, $daysToAgeRestriction) = C4::Circulation::GetAgeRestriction('Age 10', $borrower);

is ( ($daysToAgeRestriction <= 0), 1, 'Age 10 allowed for a 15 year old' );

($restriction_age, $daysToAgeRestriction) = C4::Circulation::GetAgeRestriction('K18', $borrower);

is ( ($daysToAgeRestriction > 0), 1, 'K18 blocked for a 15 year old' );

testAgeAccessors(\%data); #Age accessor tests don't touch the db so it is safe to run them with just the object.

### ------------------------------------- ###

### Testing GetAge() / SetAge() functions ###

### ------------------------------------- ###

#USES the package $member-variable to mock a koha.borrowers-object

sub testAgeAccessors {

    my ($member) = @_;

    ##Testing GetAge()

    my $age=GetAge("1992-08-14", "2011-01-19");

    is ($age, "18", "Age correct");

    $age=GetAge("2011-01-19", "1992-01-19");

    is ($age, "-19", "Birthday In the Future");

    ##Testing SetAge() for now()

    my $dt_now = DateTime->now();

    my $age = DateTime::Duration->new(years => 12, months => 6, days => 1);

    C4::Members::SetAge( $member, $age );

    $age = C4::Members::GetAge( $member->{dateofbirth} );

    is ($age, '12', "SetAge 12 years");

    $age = DateTime::Duration->new(years => 18, months => 12, days => 31);

    C4::Members::SetAge( $member, $age );

    $age = C4::Members::GetAge( $member->{dateofbirth} );

    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.

    $age = DateTime::Duration->new(years => 18, months => 12, days => 30);

    C4::Members::SetAge( $member, $age );

    $age = C4::Members::GetAge( $member->{dateofbirth} );

    is ($age, '19', "SetAge 18 years");

    $age = DateTime::Duration->new(years => 0, months => 1, days => 1);

    C4::Members::SetAge( $member, $age );

    $age = C4::Members::GetAge( $member->{dateofbirth} );

    is ($age, '0', "SetAge 0 years");

    $age = '0018-12-31';

    C4::Members::SetAge( $member, $age );

    $age = C4::Members::GetAge( $member->{dateofbirth} );

    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.

    $age = '0018-12-30';

    C4::Members::SetAge( $member, $age );

    $age = C4::Members::GetAge( $member->{dateofbirth} );

    is ($age, '19', "SetAge ISO_Date 18 years");

    $age = '18-1-1';

    eval { C4::Members::SetAge( $member, $age ); };

    is ((length $@ > 1), '1', "SetAge ISO_Date $age years FAILS");

    $age = '0018-01-01';

    eval { C4::Members::SetAge( $member, $age ); };

    is ((length $@ == 0), '1', "SetAge ISO_Date $age years succeeds");

    ##Testing SetAge() for relative_date

    my $relative_date = DateTime->new(year => 3010, month => 3, day => 15);

    $age = DateTime::Duration->new(years => 10, months => 3);

    C4::Members::SetAge( $member, $age, $relative_date );

    $age = C4::Members::GetAge( $member->{dateofbirth}, $relative_date->ymd() );

    is ($age, '10', "SetAge, 10 years and 3 months old person was born on ".$member->{dateofbirth}." if todays is ".$relative_date->ymd());

    $age = DateTime::Duration->new(years => 112, months => 1, days => 1);

    C4::Members::SetAge( $member, $age, $relative_date );

    $age = C4::Members::GetAge( $member->{dateofbirth}, $relative_date->ymd() );

    is ($age, '112', "SetAge, 112 years, 1 months and 1 days old person was born on ".$member->{dateofbirth}." if today is ".$relative_date->ymd());

    $age = '0112-01-01';

    C4::Members::SetAge( $member, $age, $relative_date );

    $age = C4::Members::GetAge( $member->{dateofbirth}, $relative_date->ymd() );

    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());

} #sub testAgeAccessors