From b6a12478ad53473f10f330f3d7dc0889bbd254f0 Mon Sep 17 00:00:00 2001
From: Olli-Antti Kivilahti <olli-antti.kivilahti@jns.fi>
Date: Fri, 17 Oct 2014 17:23:21 +0300
Subject: [PATCH] Bug 13106 - Encapsulate Circulation::GetAgeRestriction() and
 modify it to check borrowers age as well.

This patch moves the logic of deciding whether or not a borrower is old enough to access this material
to its own function GetAgeRestriction.

This makes it easier to use AgeRestriction elsewhere, like with placing holds.

This feature adds a new function C4::Members::SetAge() to make testing ages a lot easier.
A ton of Unit tests included.
---
 C4/Circulation.pm                     |   68 +++++++++++++++++----------
 C4/Members.pm                         |   43 +++++++++++++++++
 t/Circulation/AgeRestrictionMarkers.t |   21 ++++++++-
 t/db_dependent/Members.t              |   82 +++++++++++++++++++++++++++++++--
 4 files changed, 183 insertions(+), 31 deletions(-)

diff --git a/C4/Circulation.pm b/C4/Circulation.pm
index 8c0b208..e332681 100644
--- a/C4/Circulation.pm
+++ b/C4/Circulation.pm
@@ -981,29 +981,14 @@ sub CanBookBeIssued {
     }
 
     ## CHECK AGE RESTRICTION
-    # get $marker from preferences. Could be something like "FSK|PEGI|Alter|Age:"
-    my $markers         = C4::Context->preference('AgeRestrictionMarker');
-    my $bibvalues       = $biblioitem->{'agerestriction'};
-    my $restriction_age = GetAgeRestriction( $bibvalues );
-
-    if ( $restriction_age > 0 ) {
-        if ( $borrower->{'dateofbirth'} ) {
-            my @alloweddate = split /-/, $borrower->{'dateofbirth'};
-            $alloweddate[0] += $restriction_age;
-
-            #Prevent runime eror on leap year (invalid date)
-            if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
-                $alloweddate[2] = 28;
-            }
-
-            if ( Date_to_Days(Today) < Date_to_Days(@alloweddate) - 1 ) {
-                if ( C4::Context->preference('AgeRestrictionOverride') ) {
-                    $needsconfirmation{AGE_RESTRICTION} = "$bibvalues";
-                }
-                else {
-                    $issuingimpossible{AGE_RESTRICTION} = "$bibvalues";
-                }
-            }
+    my $agerestriction  = $biblioitem->{'agerestriction'};
+    my ($restriction_age, $daysToAgeRestriction) = GetAgeRestriction( $agerestriction, $borrower );
+    if ( $daysToAgeRestriction > 0 ) {
+        if ( C4::Context->preference('AgeRestrictionOverride') ) {
+            $needsconfirmation{AGE_RESTRICTION} = "$agerestriction";
+        }
+        else {
+            $issuingimpossible{AGE_RESTRICTION} = "$agerestriction";
         }
     }
 
@@ -3737,8 +3722,23 @@ sub IsItemIssued {
     return $sth->fetchrow;
 }
 
+=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
+
 sub GetAgeRestriction {
-    my ($record_restrictions) = @_;
+    my ($record_restrictions, $borrower) = @_;
     my $markers = C4::Context->preference('AgeRestrictionMarker');
 
     # Split $record_restrictions to something like FSK 16 or PEGI 6
@@ -3772,7 +3772,25 @@ sub GetAgeRestriction {
         last if ( $restriction_year > 0 );
     }
 
-    return $restriction_year;
+    #Check if the borrower is age restricted for this material and for how long.
+    if ($restriction_year && $borrower) {
+        if ( $borrower->{'dateofbirth'} ) {
+            my @alloweddate = split /-/, $borrower->{'dateofbirth'};
+            $alloweddate[0] += $restriction_year;
+
+            #Prevent runime eror on leap year (invalid date)
+            if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
+                $alloweddate[2] = 28;
+            }
+
+            #Get how many days the borrower has to reach the age restriction
+            my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(Today);
+            #Negative days means the borrower went past the age restriction age
+            return ($restriction_year, $daysToAgeRestriction);
+        }
+    }
+
+    return ($restriction_year);
 }
 
 1;
diff --git a/C4/Members.pm b/C4/Members.pm
index e3a5538..cbc3b35 100644
--- a/C4/Members.pm
+++ b/C4/Members.pm
@@ -1748,6 +1748,49 @@ sub GetAge{
     return $age;
 }    # sub get_age
 
+=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
+
 =head2 GetCities
 
   $cityarrayref = GetCities();
diff --git a/t/Circulation/AgeRestrictionMarkers.t b/t/Circulation/AgeRestrictionMarkers.t
index 619e4ea..750bf9b 100644
--- a/t/Circulation/AgeRestrictionMarkers.t
+++ b/t/Circulation/AgeRestrictionMarkers.t
@@ -1,5 +1,8 @@
+#!/usr/bin/perl
+
 use Modern::Perl;
-use Test::More tests => 5;
+use DateTime;
+use Test::More tests => 10;
 
 use t::lib::Mocks;
 
@@ -13,3 +16,19 @@ is ( C4::Circulation::GetAgeRestriction('PEGI16'), '16', 'PEGI16 returns 16' );
 is ( C4::Circulation::GetAgeRestriction('Age 16'), '16', 'Age 16 returns 16' );
 is ( C4::Circulation::GetAgeRestriction('K16'), '16', 'K16 returns 16' );
 
+
+##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' );
\ No newline at end of file
diff --git a/t/db_dependent/Members.t b/t/db_dependent/Members.t
index 592c463..bddebb2 100755
--- a/t/db_dependent/Members.t
+++ b/t/db_dependent/Members.t
@@ -17,7 +17,7 @@
 
 use Modern::Perl;
 
-use Test::More tests => 56;
+use Test::More tests => 67;
 use Test::MockModule;
 use Data::Dumper;
 use C4::Context;
@@ -82,6 +82,8 @@ my %data = (
     userid => 'tomasito'
 );
 
+testAgeAccessors(\%data); #Age accessor tests don't touch the db so it is safe to run them with just the object.
+
 my $addmem=AddMember(%data);
 ok($addmem, "AddMember()");
 
@@ -182,11 +184,7 @@ C4::Context->clear_syspref_cache();
 $checkcardnum=C4::Members::checkcardnumber($IMPOSSIBLE_CARDNUMBER, "");
 is ($checkcardnum, "2", "Card number is too long");
 
-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");
 
 C4::Context->set_preference( 'AutoEmailPrimaryAddress', 'OFF' );
 C4::Context->clear_syspref_cache();
@@ -329,4 +327,78 @@ sub _find_member {
     return $found;
 }
 
+### ------------------------------------- ###
+### 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
+
 1;
-- 
1.7.9.5