lib/Catalyst/Authentication/Store/Htpasswd/User.pm

   1 #!/usr/bin/perl
   2
   3 package Catalyst::Authentication::Store::Htpasswd::User;
   4 use base qw/Catalyst::Authentication::User Class::Accessor::Fast/;
   5
   6 use strict;
   7 use warnings;
   8
   9 our $VERSION = '1.005';
  10
  11 BEGIN { __PACKAGE__->mk_accessors(qw/_user _store/) }
  12
  13 use overload '""' => sub { shift->id }, fallback => 1;
  14
  15 sub new {
  16         my ( $class, $store, $user ) = @_;
  17
  18         return unless $user;
  19
  20         bless { _store => $store, _user => $user }, $class;
  21 }
  22
  23 sub id {
  24     my $self = shift;
  25     return $self->_user->username;
  26 }
  27
  28 sub supported_features {
  29         return {
  30         password => {
  31             self_check => 1,
  32                 },
  33         session => 1,
  34         roles => 1,
  35         };
  36 }
  37
  38 sub check_password {
  39         my ( $self, $password ) = @_;
  40         return $self->_user->check_password( $password );
  41 }
  42
  43 sub roles {
  44         my $self = shift;
  45         my $field = $self->_user->extra_info->[0];
  46         return defined $field ? split /,/, $field : ();
  47 }
  48
  49 *for_session = \&id;
  50
  51 *get_object = \&_user;
  52
  53 sub AUTOLOAD {
  54         my $self = shift;
  55
  56         ( my $method ) = ( our $AUTOLOAD =~ /([^:]+)$/ );
  57
  58         return if $method eq "DESTROY";
  59
  60         $self->_user->$method;
  61 }
  62
  63 1;
  64
  65 __END__
  66
  67 =pod
  68
  69 =head1 NAME
  70
  71 Catalyst::Authentication::Store::Htpasswd::User - A user object
  72 representing an entry in an htpasswd file.
  73
  74 =head1 DESCRIPTION
  75
  76 This object wraps an L<Authen::Htpasswd::User> object. An instance of it will be returned
  77 by C<< $c->user >> when using L<Catalyst::Authentication::Store::Htpasswd>. Methods
  78 not defined in this module are passed through to the L<Authen::Htpasswd::User> object. The
  79 object stringifies to the username.
  80
  81 =head1 METHODS
  82
  83 =head2 new($store,$user)
  84
  85 Creates a new object from a store object, normally an instance of
  86 L<Catalyst::Authentication::Store::Htpasswd::Backend>, and a user object,
  87 normally an instance of L<Authen::Htpasswd::User>.
  88
  89 =head2 id
  90
  91 Returns the username.
  92
  93 =head2 check_password($password)
  94
  95 Returns whether the password is valid.
  96
  97 =head2 roles
  98
  99 Returns an array of roles, which is extracted from a comma-separated list in the
 100 third field of the htpasswd file.
 101
 102 =head2 for_session
 103
 104 Returns the username, which is then stored in the session.
 105
 106 =head2 supported_features
 107
 108 Returns data about which featurs this user module supports.
 109
 110 =head2 get_object
 111
 112 Returns the underlieing L<Authen::Htpasswd::User> object for this user
 113
 114 =head1 AUTHORS
 115
 116 Yuval Kogman C<nothingmuch@woobling.org>
 117
 118 David Kamholz C<dkamholz@cpan.org>
 119
 120 Tomas Doran C<bobtfish@bobtfish.net>
 121
 122 =head1 COPYRIGHT & LICENSE
 123
 124         Copyright (c) 2005 the aforementioned authors. All rights
 125         reserved. This program is free software; you can redistribute
 126         it and/or modify it under the same terms as Perl itself.
 127
 128 =cut
 129
 130