<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Authen::Simple::Adapter;

use strict;
use warnings;
use base qw[Class::Accessor::Fast Class::Data::Inheritable];

use Authen::Simple::Log      qw[];
use Authen::Simple::Password qw[];
use Carp                     qw[];
use Params::Validate         qw[];

__PACKAGE__-&gt;mk_classdata( _options =&gt; { } );
__PACKAGE__-&gt;mk_accessors( qw[ cache callback log ] );

sub new {
    my $proto  = shift;
    my $class  = ref($proto) || $proto;

    my $params = Params::Validate::validate_with(
        params =&gt; \@_,
        spec   =&gt; $class-&gt;options,
        called =&gt; "$class\::new"
    );

    return $class-&gt;SUPER::new-&gt;init($params);
}

sub init {
    my ( $self, $params ) = @_;

    while ( my ( $method, $value ) = each( %{ $params } ) ) {
        $self-&gt;$method($value);
    }

    return $self;
}

sub authenticate {
    my $self  = shift;
    my $class = ref($self) || $self;

    my ( $username, $password ) = Params::Validate::validate_with(
        params =&gt; \@_,
        spec   =&gt; [
            {
                type =&gt; Params::Validate::SCALAR
            },
            {
                type =&gt; Params::Validate::SCALAR
            }
        ],
        called =&gt; "$class\::authenticate"
    );

    my $status;

    if ( $self-&gt;callback ) {

        $status = $self-&gt;callback-&gt;( \$username, \$password );

        if ( defined $status ) {

            my $boolean = $status ? 'true' : 'false';

            $self-&gt;log-&gt;debug( qq/Callback returned a $boolean value '$status' for user '$username'./ )
              if $self-&gt;log;

            return $status;
        }
    }

    if ( $self-&gt;cache ) {

        $status = $self-&gt;cache-&gt;get("$username:$password");

        if ( defined $status ) {

            $self-&gt;log-&gt;debug( qq/Successfully authenticated user '$username' from cache./ )
              if $self-&gt;log;

            return $status;
        }
    }

    $status = $self-&gt;check( $username, $password );

    if ( $self-&gt;cache &amp;&amp; $status ) {

        $self-&gt;cache-&gt;set( "$username:$password" =&gt; $status );
        
        $self-&gt;log-&gt;debug( qq/Caching successful authentication status '$status' for user '$username'./ )
          if $self-&gt;log;
    }

    return $status;
}

sub check {
    Carp::croak( __PACKAGE__ . qq/-&gt;check is an abstract method/ );
}

sub check_password {
    my $self = shift;
    return Authen::Simple::Password-&gt;check(@_);
}

sub options {
    my $proto = shift;
    my $class = ref($proto) || $proto;

    if ( @_ ) {

        my ($options) = Params::Validate::validate_pos( @_, { type =&gt; Params::Validate::HASHREF } );

        if ( my @create = grep { ! $class-&gt;can($_) } keys %{ $options } ) {
            $class-&gt;mk_accessors(@create);
        }

        $options-&gt;{cache} ||= {
            type     =&gt; Params::Validate::OBJECT,
            can      =&gt; [ qw[get set] ],
            optional =&gt; 1
        };

        $options-&gt;{callback} ||= {
            type     =&gt; Params::Validate::CODEREF,
            optional =&gt; 1
        };

        $options-&gt;{log} ||= {
            type     =&gt; Params::Validate::OBJECT,
            can      =&gt; [ qw[debug info error warn] ],
            default  =&gt; Authen::Simple::Log-&gt;new,
            optional =&gt; 1
        };

        $class-&gt;_options($options);
    }

    return $class-&gt;_options;
}

1;

__END__

=head1 NAME

Authen::Simple::Adapter - Adapter class for implementations

=head1 SYNOPSIS

    package Authenticate::Simple::Larry;
    
    use strict;
    use base 'Authen::Simple::Adapter';
    
    __PACKAGE__-&gt;options({
        secret =&gt; {
            type     =&gt; Params::Validate::SCALAR,
            default  =&gt; 'wall',
            optional =&gt; 1
        }
    });
    
    sub check {
        my ( $self, $username, $password ) = @_;
        
        if ( $username eq 'larry' &amp;&amp; $password eq $self-&gt;secret ) {
            
            $self-&gt;log-&gt;debug( qq/Successfully authenticated user '$username'./ )
              if $self-&gt;log;
            
            return 1;
        }
        
        $self-&gt;log-&gt;debug( qq/Failed to authenticate user '$username'. Reason: 'Invalid credentials'/ )
          if $self-&gt;log;
        
        return 0;
    }
    
    1;

=head1 DESCRIPTION

Adapter class for implementations.

=head1 METHODS

=over 4

=item * new ( %parameters )

If overloaded, this method should take a hash of parameters. The following 
options should be valid:

=over 8

=item * cache ( $ )

Any object that supports C&lt;get&gt;, C&lt;set&gt;. Only successful authentications are cached.

    cache =&gt; Cache::FastMmap-&gt;new

=item * callback ( \&amp; )

A subref that gets called with two scalar references, username and password.

    callback = sub {
        my ( $username, $password ) = @_;
        
        if ( length($$password) &lt; 6 ) {
            return 0; # abort, invalid credintials
        }
        
        if ( $$password eq 'secret' ) {
            return 1; # abort, successful authentication
        }
        
        return; # proceed;
    }
    
=item * log ( $ )

Any object that supports C&lt;debug&gt;, C&lt;info&gt;, C&lt;error&gt; and C&lt;warn&gt;.

    log =&gt; Log::Log4perl-&gt;get_logger('Authen::Simple')
    log =&gt; $r-&gt;log
    log =&gt; $r-&gt;server-&gt;log

=back

=item * init ( \%parameters )

This method is called after construction. It should assign parameters and return 
the instance.

    sub init {
        my ( $self, $parameters ) = @_;
        
        # mock with parameters
        
        return $self-&gt;SUPER::init($parameters);
    }

=item * authenticate ( $username, $password )

End user method. Applies callback, checks cache and calls C&lt;check&gt; unless 
aborted by callback or a cache hit.

=item * check ( $username, $password )

Must be implemented in sublcass, should return true on success and false on failure.

=item * check_password( $password, $encrypted )

=item * options ( \%options )

Must be set in subclass, should be a valid L&lt;Params::Validate&gt; specification. 
Accessors for options will be created unless defined in sublcass.

    __PACKAGE__-&gt;options({
        host =&gt; {
            type     =&gt; Params::Validate::SCALAR,
            optional =&gt; 0
        },
        port =&gt; {
            type     =&gt; Params::Validate::SCALAR,
            default  =&gt; 80,
            optional =&gt; 1
        }
    });

=back

=head1 SEE ALSO

L&lt;Authen::Simple&gt;

L&lt;Authen::Simple::Password&gt;

L&lt;Params::Validate&gt;

=head1 AUTHOR

Christian Hansen C&lt;chansen@cpan.org&gt;

=head1 COPYRIGHT

This program is free software, you can redistribute it and/or modify 
it under the same terms as Perl itself.

=cut
</pre></body></html>