From 3800e1939600168bb763b661fda5fd358ea8948c Mon Sep 17 00:00:00 2001 From: Bill Erickson Date: Wed, 25 May 2016 11:21:24 -0400 Subject: [PATCH] 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 --- .../lib/OpenILS/WWW/EGCatLoader/Register.pm | 34 ++++++++++++++++++++++ 1 file changed, 34 insertions(+) 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 9201f88249..ff6c9830cd 100644 --- 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) = @_; -- 2.11.0