CGI::Ex 2.20

[chaz/p5-CGI-Ex] / lib / CGI / Ex / Auth.pm

diff --git a/lib/CGI/Ex/Auth.pm b/lib/CGI/Ex/Auth.pm
index 85c28fe0dc0794c0c8d82a09698a14bb13b8a0cb..a762ead3de1944ae0b767ad913319dc2f7b27836 100644 (file)
--- a/lib/CGI/Ex/Auth.pm
+++ b/lib/CGI/Ex/Auth.pm
@@ -18,7 +18,7 @@ use MIME::Base64 qw(encode_base64 decode_base64);
 use Digest::MD5 qw(md5_hex);
 use CGI::Ex;
 
-$VERSION = '2.19';
+$VERSION = '2.20';
 
 ###----------------------------------------------------------------###
 
@@ -138,6 +138,7 @@ sub handle_success {
 
     ### if they have cookies we are done
     } elsif (scalar(keys %{$self->cookies}) || $self->no_cookie_verify) {
+        $self->success_hook;
         return $self;
 
     ### need to verify cookies are set-able
@@ -151,6 +152,14 @@ sub handle_success {
     }
 }
 
+sub success_hook {
+    my $self = shift;
+    if (my $meth = $self->{'success_hook'}) {
+        return $meth->($self);
+    }
+    return;
+}
+
 sub handle_failure {
     my $self = shift;
     my $args = shift || {};
@@ -181,10 +190,19 @@ sub handle_failure {
 
     ### allow for a sleep to help prevent brute force
     sleep($self->failed_sleep) if defined($data) && $data->error ne 'Login expired' && $self->failed_sleep;
+    $self->failure_hook;
 
     return;
 }
 
+sub failure_hook {
+    my $self = shift;
+    if (my $meth = $self->{'failure_hook'}) {
+        return $meth->($self);
+    }
+    return;
+}
+
 sub check_valid_auth {
     my $self = shift;
     $self = $self->new(@_) if ! ref $self;
@@ -930,6 +948,8 @@ defined separately.
     login_template
     handle_success
     handle_failure
+    success_hook
+    failure_hook
     no_cookie_verify
     path_info
     script_name