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