diff --git a/Webperl/Auth.pm b/Webperl/Auth.pm index 56ef98d..7a9edce 100644 --- a/Webperl/Auth.pm +++ b/Webperl/Auth.pm @@ -585,4 +585,26 @@ sub apply_policy { } +## @method $ get_policy($username) +# Obtain a hash containing the password policy settings. This generates a hash containing +# the details of the password policy (effectively, all 'policy_*' values set for the +# current AuthMethod) and returns a reference to it. +# +# @param username The name of the user to obtain the password policy for. +# @return A reference to a hash containing the policy settings for the user's AuthMethod, +# if no policy is currently in place, this returns undef. +sub get_policy { + my $self = shift; + my $username = shift; + + $self -> clear_error(); + + my $methodimpl = $self -> get_user_authmethod_module($username) + or return undef; + + return $methodimpl -> get_policy() + or return $self -> self_error($methodimpl -> errstr()); +} + + 1; diff --git a/Webperl/AuthMethod.pm b/Webperl/AuthMethod.pm index a9f01f0..7100470 100644 --- a/Webperl/AuthMethod.pm +++ b/Webperl/AuthMethod.pm @@ -355,4 +355,26 @@ sub apply_policy { return scalar(keys(%$failures)) ? $failures : undef; } + +## @method $ get_policy() +# Obtain a hash containing the password policy settings. This generates a hash containing +# the details of the password policy (effectively, all 'policy_*' values set for the +# current AuthMethod) and returns a reference to it. +# +# @return A reference to a hash containing the AuthMethod's policy settings, if no +# policy is currently in place, this returns undef. +sub get_policy { + my $self = shift; + my %policy; + + # Get the list of keys that start 'policy_' + my @policy_keys = grep {/^policy_/} keys %{$self}; + + # And a hash slice from those keys. + @policy{@policy_keys} = @$self{@policy_keys}; + + return scalar(%policy) ? \%policy : undef; +} + + 1;