libauthen-htpasswd-perl 0.171-1 / usr / share / perl5 / Authen / Htpasswd / User.pm

package Authen::Htpasswd::User;
use strict;
use base 'Class::Accessor::Fast';
use Carp;
use Authen::Htpasswd;
use Authen::Htpasswd::Util;

use overload '""' => \&to_line, bool => sub { 1 }, fallback => 1;

__PACKAGE__->mk_accessors(qw/ file encrypt_hash check_hashes /);

=head1 NAME

Authen::Htpasswd::User - represents a user line in a .htpasswd file

=head1 SYNOPSIS

    my $user = Authen::Htpasswd::User->new($username, $password[, @extra_info], \%options);
    my $user = $pwfile->lookup_user($username); # from Authen::Htpasswd object
    
    if ($user->check_password($password)) { ... }
    if ($user->hashed_password eq $foo) { ... }
    
    # these are written immediately if the user was looked up from an Authen::Htpasswd object
    $user->username('bill');
    $user->password('bar');
    $user->hashed_password('tIYAwma5mxexA');
    $user->extra_info('root', 'joe@site.com', 'Joe Sysadmin');
    $user->set(username => 'bill', password => 'foo'); # set several at once
    
    print $user->to_line, "\n";
 
=head1 METHODS

=head2 new

    my $userobj = Authen::Htpasswd::User->new($username, $password[, @extra_info], \%options);

Creates a user object. You may also specify the arguments and options together in a hash: 
C<< { username => $foo, password => $bar, extra_info => [$email, $name], ... } >>.

=over 4

=item encrypt_hash

=item check_hashes

See L<Authen::Htpasswd>.

=item hashed_password

Explicitly sets the value of the hashed password, rather than generating it with C<password>.

=back

=cut

sub new {
    my $class = shift;
    croak "not enough arguments" if @_ < 2;
    
    my $self = ref $_[-1] eq 'HASH' ? pop @_ : {};
    $self->{encrypt_hash} ||= 'crypt';
    $self->{check_hashes} ||= [ Authen::Htpasswd::Util::supported_hashes() ];
    $self->{autocommit} = 1;

    $self->{username} = $_[0];
    $self->{hashed_password} ||= htpasswd_encrypt($self->{encrypt_hash}, $_[1]) if defined $_[1];
    $self->{extra_info} = [ @_[2..$#_] ] if defined $_[2];

    bless $self, $class;
}

=head2 check_password

    $userobj->check_password($password,\@check_hashes);

Returns whether the password matches. C<check_hashes> is the same as for Authen::Htpasswd.

=cut

sub check_password {
    my ($self,$password,$hashes) = @_;
    $hashes ||= $self->check_hashes;
    foreach my $hash (@$hashes) {
        return 1 if $self->hashed_password eq htpasswd_encrypt($hash, $password, $self->hashed_password);
    }
    return 0;
}

=head2 username

=head2 hashed_password

=head2 extra_info(@fields)

Get and set the fields of the user line. These methods, as well as C<password> and C<set> below, write 
any changes immediately if the user was lookup up from an Authen::Htpasswd object. If the username is
changed, the old entry is I<not> preserved.

=cut

sub username {
    my $self = shift;
    if (@_) {
        $self->{old_username} = $self->{username} if $self->{username} ne $_[0];
        $self->{username} = shift;
        $self->_update if $self->{autocommit};        
    }
    return $self->{username};
}

sub hashed_password {
    my $self = shift;
    if (@_) {
        $self->{hashed_password} = shift;
        $self->_update if $self->{autocommit};        
    }
    return $self->{hashed_password};
}

sub extra_info {
    my $self = shift;
    if (@_) {
        $self->{extra_info} = [ @_ ];
        $self->_update if $self->{autocommit};        
    }
    return $self->{extra_info};
}

=head2 password
    
    $userobj->password($newpass);

Encrypts a new password. Dies if C<$newpass> is not provided.

=cut

sub password {
    my ($self,$password) = @_;
    croak "you must provide a new password" unless defined $password;
    $self->hashed_password( htpasswd_encrypt($self->encrypt_hash, $password) );
}

=head2 set

    $userobj->set(item => $value, ...);

Sets any of the four preceding values at once. Only writes the file once if it is going to be written.

=cut

sub set {
    my ($self,%attr) = @_;
    $self->{autocommit} = 0;
    while (my ($key,$value) = each %attr) {
        croak "don't know how to set $key" unless $self->can($key);
        $self->$key(ref $value eq 'ARRAY' ? @$value : $value);
    }    
    $self->_update;        
    $self->{autocommit} = 1;
}

=head2 to_line

    $userobj->to_line;

Returns a line for the user, suitable for printing to a C<.htpasswd> file. There is no newline at the end.

=cut

sub to_line {
    my $self = shift;
    return join(':', $self->username, $self->hashed_password,
        defined $self->extra_info ? @{$self->extra_info} : ());
}

sub _update {
    my $self = shift;
    if ($self->file) {
        if (defined $self->{old_username}) {
            $self->file->delete_user($self->{old_username});
            delete $self->{old_username};            
        }
        $self->file->update_user($self);
    }
}

=head1 AUTHOR

David Kamholz C<dkamholz@cpan.org>

Yuval Kogman

=head1 COPYRIGHT & LICENSE

    Copyright (c) 2005 - 2007 the aforementioned authors.
    
    This program is free software; you can redistribute
    it and/or modify it under the same terms as Perl itself.

=cut

1;