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

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