File Coverage

blib/lib/CGI/Application/Plugin/Authentication/Driver/Generic.pm
Criterion Covered Total %
statement 22 22 100.0
branch 13 14 92.8
condition 6 6 100.0
subroutine 4 4 100.0
pod 1 1 100.0
total 46 47 97.8


line stmt bran cond sub pod time code
1             package CGI::Application::Plugin::Authentication::Driver::Generic;
2             $CGI::Application::Plugin::Authentication::Driver::Generic::VERSION = '0.21';
3 14     14   62 use strict;
  14         20  
  14         411  
4 14     14   78 use warnings;
  14         18  
  14         485  
5              
6 14     14   77 use base qw(CGI::Application::Plugin::Authentication::Driver);
  14         19  
  14         6886  
7              
8             =head1 NAME
9              
10             CGI::Application::Plugin::Authentication::Driver::Generic - Generic Authentication driver
11              
12             =head1 SYNOPSIS
13              
14             use base qw(CGI::Application);
15             use CGI::Application::Plugin::Authentication;
16              
17             __PACKAGE__->authen->config(
18             DRIVER => [ 'Generic', { user1 => '123', user2 => '123' } ],
19             );
20              
21             =head1 DESCRIPTION
22              
23             This Driver offers a simple way to provide a user database to the
24             L plugin. It offers three ways
25             to provide a list of users to the plugin by providing a hash of username/password pairs,
26             an array of arrays containing the username and password pairs, or a code
27             reference that returns back the username, or undef on success or failure.
28              
29             =head1 EXAMPLE
30              
31             my %users = (
32             user1 => '123',
33             user2 => '123',
34             );
35             __PACKAGE__->authen->config(
36             DRIVER => [ 'Generic', \%users ],
37             );
38              
39             - or -
40              
41             my @users = (
42             ['example.com', 'user1', '123'],
43             ['example.com', 'user2', '123'],
44             ['foobar.com', 'user1', '123'],
45             );
46             __PACKAGE__->authen->config(
47             DRIVER => [ 'Generic', \@users ],
48             CREDENTIALS => [ 'authen_domain', 'authen_username', 'authen_password' ]
49             );
50              
51             - or -
52              
53             sub check_password {
54             my @credentials = @_;
55             if ($credentials[0] eq 'test' && $credentials[1] eq 'secret') {
56             return 'testuser';
57             }
58             return;
59             }
60              
61             __PACKAGE__->authen->config(
62             DRIVER => [ 'Generic', \&check_password ],
63             );
64              
65              
66             =head1 METHODS
67              
68             =head2 verify_credentials
69              
70             This method will test the provided credentials against either the hash ref, array ref or code ref
71             that the driver was configured with.
72              
73             =cut
74              
75             sub verify_credentials {
76 71     71 1 84 my $self = shift;
77 71         130 my @creds = @_;
78 71         213 my @options = $self->options;
79 71         85 my $data = $options[0];
80              
81 71 100       202 if ( ref $data eq 'HASH' ) {
    100          
    100          
82 50 100 100     314 return undef unless( defined( $creds[0] ) && defined( $creds[1] ) );
83 40 100 100     324 return ( defined $data->{ $creds[0] } && $data->{ $creds[0] } eq $creds[1] ) ? $creds[0] : undef;
84             } elsif ( ref $data eq 'ARRAY' ) {
85 11         16 foreach my $row (@$data) {
86 21 50       29 return $creds[0] unless grep { !defined $creds[$_] || $creds[$_] ne $row->[$_] } 0..$#$row;
  42 100       201  
87             }
88 9         34 return undef;
89             } elsif ( ref $data eq 'CODE' ) {
90 9         22 return $data->(@creds);
91             }
92 1         9 die "Unknown options for Generic Driver";
93             }
94              
95              
96             =head1 SEE ALSO
97              
98             L, L, perl(1)
99              
100              
101             =head1 LICENCE AND COPYRIGHT
102              
103             Copyright (c) 2005, SiteSuite. All rights reserved.
104              
105             This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
106              
107              
108             =head1 DISCLAIMER OF WARRANTY
109              
110             BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION.
111              
112             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
113              
114             =cut
115              
116             1;