CGI::Ex 2.18

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

diff --git a/lib/CGI/Ex/Auth.pm b/lib/CGI/Ex/Auth.pm
index 337801cd6b4da37927eb23fd8c2a9198fd8e2c39..70d754e47f0bf7ba9d68d75001f2807cb1df00ef 100644 (file)
--- a/lib/CGI/Ex/Auth.pm
+++ b/lib/CGI/Ex/Auth.pm
@@ -7,7 +7,7 @@ CGI::Ex::Auth - Handle logins nicely.
 =cut
 
 ###----------------------------------------------------------------###
-#  Copyright 2006 - Paul Seamons                                     #
+#  Copyright 2007 - Paul Seamons                                     #
 #  Distributed under the Perl Artistic License without warranty      #
 ###----------------------------------------------------------------###
 
@@ -18,7 +18,7 @@ use MIME::Base64 qw(encode_base64 decode_base64);
 use Digest::MD5 qw(md5_hex);
 use CGI::Ex;
 
-$VERSION = '2.04';
+$VERSION = '2.18';
 
 ###----------------------------------------------------------------###
 
@@ -61,7 +61,7 @@ sub get_valid_auth {
         next if ! defined $hash->{$key};
         $had_form_info ++ if $is_form;
 
-        ### if it looks like a bare username (as in they didn't have javascript)- add in other items
+        ### if it looks like a bare username (as in they didn't have javascript) - add in other items
         my $data;
         if ($is_form
             && $hash->{$key} !~ m|^[^/]+/|
@@ -180,6 +180,7 @@ sub cookies {
 sub delete_cookie {
     my $self = shift;
     my $args = shift;
+    return $self->{'delete_cookie'}->($self, $args) if $self->{'delete_cookie'};
     my $key  = $args->{'key'};
     $self->cgix->set_cookie({
         -name    => $key,
@@ -193,6 +194,7 @@ sub delete_cookie {
 sub set_cookie {
     my $self = shift;
     my $args = shift;
+    return $self->{'set_cookie'}->($self, $args) if $self->{'set_cookie'};
     my $key  = $args->{'key'};
     my $val  = $args->{'val'};
     $self->cgix->set_cookie({
@@ -207,6 +209,7 @@ sub set_cookie {
 sub location_bounce {
     my $self = shift;
     my $url  = shift;
+    return $self->{'location_bounce'}->($self, $url) if $self->{'location_bounce'};
     return $self->cgix->location_bounce($url);
 }
 
@@ -484,7 +487,8 @@ sub generate_token {
     if (   (defined($data->{'use_plaintext'}) ?  $data->{'use_plaintext'} : $self->use_plaintext) # ->use_plaintext is true if ->use_crypt is
         || (defined($data->{'use_crypt'})     && $data->{'use_crypt'})
         || (defined($data->{'type'})          && $data->{'type'} eq 'crypt')) {
-        $token = $data->{'user'} .'/'. $data->{'real_pass'};
+        my $pass = defined($data->{'test_pass'}) ? $data->{'test_pass'} : $data->{'real_pass'};
+        $token = $data->{'user'} .'/'. $pass;
 
     ### all other types go to cram - secure_hash_cram, cram, plaintext and md5
     } else {
@@ -728,18 +732,38 @@ __END__
 
 =head1 SYNOPSIS
 
-  ### authorize the user
-  my $auth = $self->get_valid_auth({
-    get_pass_by_user => \&get_pass_by_user,
-  });
+    use CGI::Ex::Auth;
 
+    ### authorize the user
+    my $auth = CGI::Ex::Auth->get_valid_auth({
+        get_pass_by_user => \&get_pass_by_user,
+    });
 
-  sub get_pass_by_user {
-    my $auth = shift;
-    my $user = shift;
-    my $pass = some_way_of_getting_password($user);
-    return $pass;
-  }
+
+    sub get_pass_by_user {
+        my $auth = shift;
+        my $user = shift;
+        my $pass = some_way_of_getting_password($user);
+        return $pass;
+    }
+
+    ### OR - if you are using a OO based CGI or Application
+
+    sub require_authentication {
+        my $self = shift;
+
+        return $self->{'auth'} = CGI::Ex::Auth->get_valid_auth({
+            get_pass_by_user => sub {
+                my ($auth, $user) = @_;
+                return $self->get_pass($user);
+            },
+        });
+    }
+
+    sub get_pass {
+        my ($self, $user) = @_;
+        return $self->loopup_and_cache_pass($user);
+    }
 
 =head1 DESCRIPTION
 
@@ -1049,7 +1073,8 @@ are not enabled, it may return the md5 sum of the password.
 
    get_pass_by_user => sub {
        my ($auth_obj, $user) = @_;
-       return $some_obj->get_pass({user => $user});
+       my $pass = $some_obj->get_pass({user => $user});
+       return $pass;
    }
 
 Alternately, get_pass_by_user may return a hashref of data items that
@@ -1129,8 +1154,12 @@ The text items shown in the default login template.  The default values are:
 
 =back
 
+=head1 LICENSE
+
+This module may be distributed under the same terms as Perl itself.
+
 =head1 AUTHORS
 
-Paul Seamons <paul at seamons dot com>
+Paul Seamons <perl at seamons dot com>
 
 =cut