X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FAuthentication%2FStore%2FHtpasswd.pm;h=1007b3494355be3507788ed3c45376f7096c1d47;hb=8f6952664282a3b1405d96e532c608665a15be6e;hp=d5c395c18f34b55476c4f0f5081b9390250f1c8e;hpb=c843ca0a0fffd0ae8d673d5c1244667d2dc23eaa;p=catagits%2FCatalyst-Authentication-Store-Htpasswd.git diff --git a/lib/Catalyst/Authentication/Store/Htpasswd.pm b/lib/Catalyst/Authentication/Store/Htpasswd.pm index d5c395c..1007b34 100644 --- a/lib/Catalyst/Authentication/Store/Htpasswd.pm +++ b/lib/Catalyst/Authentication/Store/Htpasswd.pm @@ -1,44 +1,49 @@ #!/usr/bin/perl package Catalyst::Authentication::Store::Htpasswd; +# ABSTRACT: Authen::Htpasswd based user storage/authentication + use base qw/Class::Accessor::Fast/; use strict; use warnings; -use Authen::Htpasswd; +use Authen::Htpasswd 0.13; use Catalyst::Authentication::Store::Htpasswd::User; use Scalar::Util qw/blessed/; -our $VERSION = '1.001'; +our $VERSION = '1.007'; -BEGIN { __PACKAGE__->mk_accessors(qw/file/) } +BEGIN { __PACKAGE__->mk_accessors(qw/file user_field user_class/) } sub new { my ($class, $config, $app, $realm) = @_; - + my $file = delete $config->{file}; - unless (ref $file) { # FIXME - file not in app.. - my $filename = $app->path_to($file)->stringify; + unless (ref $file) { + my $filename = ($file =~ m|^/|) ? $file : $app->path_to($file)->stringify; die("Cannot find htpasswd file: $filename\n") unless (-r $filename); $file = Authen::Htpasswd->new($filename); } $config->{file} = $file; - + $config->{user_class} ||= __PACKAGE__ . '::User'; + $config->{user_field} ||= 'username'; + bless { %$config }, $class; } sub find_user { my ($self, $authinfo, $c) = @_; - # FIXME - change username - my $htpasswd_user = $self->file->lookup_user($authinfo->{username}); - Catalyst::Authentication::Store::Htpasswd::User->new( $self, $htpasswd_user ); + my $htpasswd_user = $self->file->lookup_user($authinfo->{$self->user_field}); + $self->user_class->new( $self, $htpasswd_user ); } sub user_supports { my $self = shift; - # this can work as a class method - Catalyst::Authentication::Store::Htpasswd::User->supports(@_); + # this can work as a class method, but in that case you can't have + # a custom user class + ref($self) ? $self->user_class->supports(@_) + : Catalyst::Authentication::Store::Htpasswd::User->supports(@_); } sub from_session { @@ -52,11 +57,6 @@ __END__ =pod -=head1 NAME - -Catalyst::Authentication::Store::Htpasswd - L based -user storage/authentication. - =head1 SYNOPSIS use Catalyst qw/ @@ -79,7 +79,7 @@ user storage/authentication. }, }, }, - }, + }, ); sub login : Global { @@ -90,8 +90,8 @@ user storage/authentication. =head1 DESCRIPTION -This plugin uses C to let your application use C<.htpasswd> -files for it's authentication storage. +This plugin uses L to let your application use C<< .htpasswd >> +files for its authentication storage. =head1 METHODS @@ -105,36 +105,50 @@ Looks up the user, and returns a Catalyst::Authentication::Store::Htpasswd::User =head2 user_supports -Delegates to Luser_supports|Catalyst::Authentication::Store::Htpasswd::User#user_supports> +Delegates to L<< Catalyst::Authentication::User->supports|Catalyst::Authentication::User/supports >> or an +override in L. =head2 from_session -Delegates the user lookup to C< find_user > +Delegates the user lookup to L =head1 CONFIGURATION =head2 file -The path to the htpasswd file, this is taken from the application root. +The path to the htpasswd file. If the path starts with a slash, then it is assumed to be a fully +qualified path, otherwise the path is fed through C<< $c->path_to >> and so normalised to the +application root. -=head1 AUTHORS +Alternatively, it is possible to pass in an L object here, and this will be +used as the htpasswd file. -Yuval Kogman C +=head2 user_class -David Kamholz C +Change the user class which this store returns. Defaults to L. +This can be used to add additional functionality to the user class by sub-classing it, but will not normally be +needed. -Tomas Doran C +=head2 user_field -=head1 SEE ALSO +Change the field that the username is found in in the information passed into the call to C<< $c->authenticate() >>. -L. +This defaults to I< username >, and generally you should be able to use the module as shown in the synopsis, however +if you need a different field name then this setting can change the default. -=head1 COPYRIGHT & LICENSE +Example: - Copyright (c) 2005-2008 the aforementioned authors. All rights - reserved. This program is free software; you can redistribute - it and/or modify it under the same terms as Perl itself. + __PACKAGE__->config( authentication => { realms => { test => { + store => { + class => 'Htpasswd', + user_field => 'email_address', + }, + }}}); + # Later in your code + $c->authenticate({ email_address => $c->req->param("email"), password => $c->req->param("password") }); -=cut +=head1 SEE ALSO +L. +=cut