JBAS-1415 Apply net_access_level in self-reg

During self-registration, if a patron is less than 17 years old, apply
the "Under 17 Plus" net_access_level to the staged user.  If the patron
is 17 or older, apply "17 and Up Only".

It shouldn't happen in practice since we require a DoB, but if no DoB is
present, no net_access_level value is applied.

Signed-off-by: Bill Erickson <berickxx@gmail.com>

diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/EGCatLoader/Register.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/EGCatLoader/Register.pm
index 9201f88..ff6c983 100644 (file)
--- a/Open-ILS/src/perlmods/lib/OpenILS/WWW/EGCatLoader/Register.pm
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/EGCatLoader/Register.pm
@@ -10,6 +10,7 @@ use OpenILS::Event;
 use Data::Dumper;
 use LWP::UserAgent;
 use OpenILS::Utils::KCLSNormalize;
+use DateTime;
 $Data::Dumper::Indent = 0;
 my $U = 'OpenILS::Application::AppUtils';
 
@@ -83,6 +84,8 @@ sub load_patron_reg {
     # KCLS JBAS-1138
     my $profile = $U->ou_ancestor_setting_value(
         $user->home_ou, 'opac.self_register.profile');
+
+    $self->apply_net_access_level($user);
     
     $user->profile($profile) if $profile;
 
@@ -108,6 +111,37 @@ sub load_patron_reg {
     return Apache2::Const::OK;
 }
 
+
+sub apply_net_access_level {
+    my ($self, $user) = @_;
+    return unless $user->dob;
+
+    # DoB is YYYY-MM-DD
+    my @parts = split(/-/, $user->dob);
+
+    my $dob_date;
+    eval {
+        # avoid dying on funky dates
+        $dob_date = DateTime->new(
+            year => $parts[0], month => $parts[1], day => $parts[2]);
+    };
+
+    return unless $dob_date;
+
+    # DoB has no time, so compare to a date w/ no time.
+    my $comp_date = DateTime->now;
+    $comp_date->set_hour(0);
+    $comp_date->set_minute(0);
+    $comp_date->set_second(0);
+    $comp_date->subtract(years => 17);
+
+    $user->net_access_level(
+        $comp_date >= $dob_date ? # 17 or older.
+        1 :                       # == 17 and Up Only
+        102                       # == Under 17 Plus
+    );
+}
+
 # returns true if the addresses contain all of the same values.
 sub addrs_match {
     my ($self, $addr1, $addr2) = @_;