[Catalyst-commits] r6531 - in trunk/Authen-Htpasswd: . lib/Authen
lib/Authen/Htpasswd t
adamk at dev.catalyst.perl.org
adamk at dev.catalyst.perl.org
Sun Jul 15 22:19:28 GMT 2007
Author: adamk
Date: 2007-07-15 22:19:28 +0100 (Sun, 15 Jul 2007)
New Revision: 6531
Removed:
trunk/Authen-Htpasswd/Makefile.PL
trunk/Authen-Htpasswd/README
Modified:
trunk/Authen-Htpasswd/Changes
trunk/Authen-Htpasswd/lib/Authen/Htpasswd.pm
trunk/Authen-Htpasswd/lib/Authen/Htpasswd/User.pm
trunk/Authen-Htpasswd/lib/Authen/Htpasswd/Util.pm
trunk/Authen-Htpasswd/t/01use.t
trunk/Authen-Htpasswd/t/02pod.t
trunk/Authen-Htpasswd/t/03podcoverage.t
trunk/Authen-Htpasswd/t/04core.t
trunk/Authen-Htpasswd/t/05edit.t
Log:
Fixing my shit
Modified: trunk/Authen-Htpasswd/Changes
===================================================================
--- trunk/Authen-Htpasswd/Changes 2007-07-15 21:05:01 UTC (rev 6530)
+++ trunk/Authen-Htpasswd/Changes 2007-07-15 21:19:28 UTC (rev 6531)
@@ -1,29 +1,25 @@
-0.16 Sun Jul 15 2007
- - Disable write locking on Win32.
- (On Win32 you cannot delete a file with an open filehandle)
-
-0.15001 Sun Jul 15 00:07:00 PDT 2007
- - use File::Spec in tests to avoid build failure on Windows
-
-0.15 Sun Dec 31 02:51:35 EST 2006
- - prevent User::password() from clobbering the password if none is passed
- - document Util::supported_hashes()
-
-0.14 Fri Mar 03 08:01:32 CET 2006
- - add all_users method
-
-0.13 Sat Nov 26 04:18:19 CET 2005
- - works if you don't have Crypt::PasswdMD5 or Digest::SHA1
- - auto-detects available modules for default check_hashes
- - added Yuval Kogman as author, also added license to POD
-
-0.12 November 10 2005
- - extra_info is now an array, as suggested by Uwe Voelker
- - changing the username will now delete the old username and add the new one
-
-0.11 November 09 2005
- - implement locking with IO::LockedFile
- - minor code and pod cleanups
-
-0.10 November 09 2005
- - initial release
+0.15001 Sun Jul 15 00:07:00 PDT 2007
+ - use File::Spec in tests to avoid build failure on Windows
+
+0.15 Sun Dec 31 02:51:35 EST 2006
+ - prevent User::password() from clobbering the password if none is passed
+ - document Util::supported_hashes()
+
+0.14 Fri Mar 03 08:01:32 CET 2006
+ - add all_users method
+
+0.13 Sat Nov 26 04:18:19 CET 2005
+ - works if you don't have Crypt::PasswdMD5 or Digest::SHA1
+ - auto-detects available modules for default check_hashes
+ - added Yuval Kogman as author, also added license to POD
+
+0.12 November 10 2005
+ - extra_info is now an array, as suggested by Uwe Voelker
+ - changing the username will now delete the old username and add the new one
+
+0.11 November 09 2005
+ - implement locking with IO::LockedFile
+ - minor code and pod cleanups
+
+0.10 November 09 2005
+ - initial release
Deleted: trunk/Authen-Htpasswd/Makefile.PL
===================================================================
--- trunk/Authen-Htpasswd/Makefile.PL 2007-07-15 21:05:01 UTC (rev 6530)
+++ trunk/Authen-Htpasswd/Makefile.PL 2007-07-15 21:19:28 UTC (rev 6531)
@@ -1,21 +0,0 @@
-use strict;
-use ExtUtils::MakeMaker;
-
-require 5.005;
-
-WriteMakefile(
- 'NAME' => 'Authen::Htpasswd',
- 'ABSTRACT' => 'Interface to read and modify Apache .htpasswd files',
- 'AUTHOR' => 'David Kamholz <dkamholz at cpan.org>',
- 'INSTALLDIRS' => 'site',
- 'LICENSE' => 'perl',
- 'VERSION_FROM' => 'lib/Authen/Htpasswd.pm',
- 'PREREQ_PM' => {
- 'Class::Accessor::Fast' => 0,
- 'IO::LockedFile' => 0,
- 'Digest' => 0,
- 'Digest::SHA1' => 0,
- 'Crypt::PasswdMD5' => 0,
- },
-
-);
Deleted: trunk/Authen-Htpasswd/README
===================================================================
--- trunk/Authen-Htpasswd/README 2007-07-15 21:05:01 UTC (rev 6530)
+++ trunk/Authen-Htpasswd/README 2007-07-15 21:19:28 UTC (rev 6531)
@@ -1,99 +0,0 @@
-NAME
- Authen::Htpasswd - interface to read and modify Apache .htpasswd files
-
-SYNOPSIS
- my $pwfile = Authen::Htpasswd->new('user.txt', { encrypt_hash => 'md5' });
-
- # authenticate a user (checks all hash methods by default)
- if ($pwfile->check_user_password('bob', 'foo')) { ... }
-
- # modify the file (writes immediately)
- $pwfile->update_user('bob', $password, $info);
- $pwfile->add_user('jim', $password);
- $pwfile->delete_user('jim');
-
- # get user objects tied to a file
- my $user = $pwfile->lookup_user('bob');
- if ($user->check_password('vroom', [qw/ md5 sha1 /])) { ... } # only use secure hashes
- $user->password('foo'); # writes to file
- $user->set(password => 'bar', extra_info => 'editor'); # change more than one thing at once
-
- # or manage the file yourself
- my $user = Authen::Htpasswd::User->new('bill', { hashed_password => 'iQ.IuWbUIhlPE' });
- my $user = Authen::Htpasswd::User->new('bill', 'bar', 'staff', { encrypt_hash => 'crypt' });
- print PASSWD $user->to_line, "\n";
-
-DESCRIPTION
- This module provides a convenient, object-oriented interface to
- Apache-style .htpasswd files. It supports passwords encrypted via MD5,
- SHA1, and crypt, as well as plain (cleartext) passwords. It requires
- Crypt::PasswdMD5 for MD5 and Digest::SHA1 for SHA1. Additional fields
- after username and password, if present, are accessible via the
- "extra_info" array.
-
-METHODS
- new
- my $pwfile = Authen::Htpasswd->new($filename, \%options);
-
- Creates an object for a given .htpasswd file. Options:
-
- encrypt_hash
- How passwords should be encrypted if a user is added or changed.
- Valid values are "md5", "sha1", "crypt", and "plain". Default is
- "crypt".
-
- check_hashes
- An array of hash methods to try when checking a password. The
- methods will be tried in the order given. Default is "md5", "sha1",
- "crypt", "plain".
-
- lookup_user
- my $userobj = $pwfile->lookup_user($username);
-
- Returns an Authen::Htpasswd::User object for the given user in the
- password file.
-
- all_users
- my @users = $pwfile->all_users;
-
- check_user_password
- $pwfile->check_user_password($username,$password);
-
- Returns whether the password is valid. Shortcut for
- "$pwfile->lookup_user($username)->check_password($password)".
-
- update_user
- $pwfile->update_user($userobj);
- $pwfile->update_user($username, $password[, @extra_info], \%options);
-
- Modifies the entry for a user saves it to the file. If the user entry
- does not exist, it is created. The options in the second form are passed
- to Authen::Htpasswd::User.
-
- add_user
- $pwfile->add_user($userobj);
- $pwfile->add_user($username, $password[, @extra_info], \%options);
-
- Adds a user entry to the file. If the user entry already exists, an
- exception is raised. The options in the second form are passed to
- Authen::Htpasswd::User.
-
- delete_user
- $pwfile->delete_user($userobj);
- $pwfile->delete_user($username);
-
- Removes a user entry from the file.
-
-AUTHOR
- David Kamholz "dkamholz at cpan.org"
-
- Yuval Kogman
-
-SEE ALSO
- Apache::Htpasswd.
-
-COPYRIGHT & LICENSE
- Copyright (c) 2005 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.
-
Modified: trunk/Authen-Htpasswd/lib/Authen/Htpasswd/User.pm
===================================================================
--- trunk/Authen-Htpasswd/lib/Authen/Htpasswd/User.pm 2007-07-15 21:05:01 UTC (rev 6530)
+++ trunk/Authen-Htpasswd/lib/Authen/Htpasswd/User.pm 2007-07-15 21:19:28 UTC (rev 6531)
@@ -5,11 +5,6 @@
use Authen::Htpasswd;
use Authen::Htpasswd::Util;
-use vars qw{$VERSION};
-BEGIN {
- $VERSION = '0.16';
-}
-
use overload '""' => \&to_line, bool => sub { 1 }, fallback => 1;
__PACKAGE__->mk_accessors(qw/ file encrypt_hash check_hashes /);
Modified: trunk/Authen-Htpasswd/lib/Authen/Htpasswd/Util.pm
===================================================================
--- trunk/Authen-Htpasswd/lib/Authen/Htpasswd/Util.pm 2007-07-15 21:05:01 UTC (rev 6530)
+++ trunk/Authen-Htpasswd/lib/Authen/Htpasswd/Util.pm 2007-07-15 21:19:28 UTC (rev 6531)
@@ -1,15 +1,11 @@
package Authen::Htpasswd::Util;
+require Exporter;
+ at ISA = qw/ Exporter /;
+ at EXPORT = qw/ htpasswd_encrypt /;
use strict;
use Digest;
use Carp;
-use vars qw{@ISA @EXPORT};
-BEGIN {
- require Exporter;
- @ISA = qw/ Exporter /;
- @EXPORT = qw/ htpasswd_encrypt /;
-}
-
my @CRYPT_CHARS = split(//, './0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz');
=head1 NAME
Modified: trunk/Authen-Htpasswd/lib/Authen/Htpasswd.pm
===================================================================
--- trunk/Authen-Htpasswd/lib/Authen/Htpasswd.pm 2007-07-15 21:05:01 UTC (rev 6530)
+++ trunk/Authen-Htpasswd/lib/Authen/Htpasswd.pm 2007-07-15 21:19:28 UTC (rev 6531)
@@ -1,328 +1,282 @@
-package Authen::Htpasswd;
-use 5.005;
-use strict;
-use base 'Class::Accessor::Fast';
-use Carp;
-use IO::File;
-use IO::LockedFile;
-use Authen::Htpasswd::User;
-
-use vars qw{$VERSION $SUFFIX};
-BEGIN {
- $VERSION = '0.16';
- $SUFFIX = '.new';
-}
-
-__PACKAGE__->mk_accessors(qw/ file encrypt_hash check_hashes /);
-
-=head1 NAME
-
-Authen::Htpasswd - interface to read and modify Apache .htpasswd files
-
-=head1 SYNOPSIS
-
- my $pwfile = Authen::Htpasswd->new('user.txt', { encrypt_hash => 'md5' });
-
- # authenticate a user (checks all hash methods by default)
- if ($pwfile->check_user_password('bob', 'foo')) { ... }
-
- # modify the file (writes immediately)
- $pwfile->update_user('bob', $password, $info);
- $pwfile->add_user('jim', $password);
- $pwfile->delete_user('jim');
-
- # get user objects tied to a file
- my $user = $pwfile->lookup_user('bob');
- if ($user->check_password('vroom', [qw/ md5 sha1 /])) { ... } # only use secure hashes
- $user->password('foo'); # writes to file
- $user->set(password => 'bar', extra_info => 'editor'); # change more than one thing at once
-
- # or manage the file yourself
- my $user = Authen::Htpasswd::User->new('bill', { hashed_password => 'iQ.IuWbUIhlPE' });
- my $user = Authen::Htpasswd::User->new('bill', 'bar', 'staff', { encrypt_hash => 'crypt' });
- print PASSWD $user->to_line, "\n";
-
-=head1 DESCRIPTION
-
-This module provides a convenient, object-oriented interface to Apache-style
-F<.htpasswd> files.
-
-It supports passwords encrypted via MD5, SHA1, and crypt, as well as plain
-(cleartext) passwords.
-
-Additional fields after username and password, if present, are accessible via
-the C<extra_info> array.
-
-=head1 METHODS
-
-=head2 new
-
- my $pwfile = Authen::Htpasswd->new($filename, \%options);
-
-Creates an object for a given F<.htpasswd> file. Options:
-
-=over 4
-
-=item encrypt_hash
-
-How passwords should be encrypted if a user is added or changed. Valid values are C<md5>, C<sha1>,
-C<crypt>, and C<plain>. Default is C<crypt>.
-
-=item check_hashes
-
-An array of hash methods to try when checking a password. The methods will be tried in the order
-given. Default is C<md5>, C<sha1>, C<crypt>, C<plain>.
-
-=back
-
-=cut
-
-sub new {
- my $class = shift;
- my $self = ref $_[-1] eq 'HASH' ? pop @_ : {};
- $self->{file} = $_[0] if $_[0];
- croak "no file specified" unless $self->{file};
- if (!-e $self->{file}) {
- open my $file, '>', $self->{file} or die $!;
- close $file or die $!;
- }
-
- $self->{encrypt_hash} ||= 'crypt';
- $self->{check_hashes} ||= [ Authen::Htpasswd::Util::supported_hashes() ];
- unless ( defined $self->{write_locking} ) {
- if ( $^O eq 'MSWin32' or $^O eq 'cygwin' ) {
- $self->{write_locking} = 0;
- } else {
- $self->{write_locking} = 1;
- }
- }
-
- bless $self, $class;
-}
-
-=head2 lookup_user
-
- my $userobj = $pwfile->lookup_user($username);
-
-Returns an L<Authen::Htpasswd::User> object for the given user in the password file.
-
-=cut
-
-sub lookup_user {
- my ($self,$search_username) = @_;
-
- my $file = IO::LockedFile->new($self->file, 'r') or die $!;
- while (defined(my $line = <$file>)) {
- chomp $line;
- my ($username,$hashed_password, at extra_info) = split /:/, $line;
- if ($username eq $search_username) {
- $file->close or die $!;
- return Authen::Htpasswd::User->new($username,undef, at extra_info, {
- file => $self,
- hashed_password => $hashed_password,
- encrypt_hash => $self->encrypt_hash,
- check_hashes => $self->check_hashes
- });
- }
- }
- $file->close or die $!;
- return undef;
-}
-
-=head2 all_users
-
- my @users = $pwfile->all_users;
-
-=cut
-
-sub all_users {
- my $self = shift;
-
- my @users;
- my $file = IO::LockedFile->new($self->file, 'r') or die $!;
- while (defined(my $line = <$file>)) {
- chomp $line;
- my ($username,$hashed_password, at extra_info) = split /:/, $line;
- push(@users, Authen::Htpasswd::User->new($username,undef, at extra_info, {
- file => $self,
- hashed_password => $hashed_password,
- encrypt_hash => $self->encrypt_hash,
- check_hashes => $self->check_hashes
- }));
- }
- $file->close or die $!;
- return @users;
-}
-
-=head2 check_user_password
-
- $pwfile->check_user_password($username,$password);
-
-Returns whether the password is valid. Shortcut for
-C<< $pwfile->lookup_user($username)->check_password($password) >>.
-
-=cut
-
-sub check_user_password {
- my ($self,$username,$password) = @_;
- my $user = $self->lookup_user($username);
- croak "could not find user $username" unless $user;
- return $user->check_password($password);
-}
-
-=head2 update_user
-
- $pwfile->update_user($userobj);
- $pwfile->update_user($username, $password[, @extra_info], \%options);
-
-Modifies the entry for a user saves it to the file. If the user entry does not
-exist, it is created. The options in the second form are passed to L<Authen::Htpasswd::User>.
-
-=cut
-
-sub update_user {
- my $self = shift;
- my $user = $self->_get_user(@_);
- my $username = $user->username;
-
- my ($old,$new) = $self->_start_rewrite;
- my $seen = 0;
- while (defined(my $line = <$old>)) {
- if ($line =~ /^\Q$username\:/) {
- chomp $line;
- my (undef,undef, at extra_info) = split /:/, $line;
- $user->{extra_info} ||= [ @extra_info ] if scalar @extra_info;
- $self->_print( $new, $user->to_line . "\n" );
- $seen++;
- } else {
- $self->_print( $new, $line );
- }
- }
- $self->_print( $new, $user->to_line . "\n" ) unless $seen;
- $self->_finish_rewrite($old,$new);
-}
-
-=head2 add_user
-
- $pwfile->add_user($userobj);
- $pwfile->add_user($username, $password[, @extra_info], \%options);
-
-Adds a user entry to the file. If the user entry already exists, an exception is raised.
-The options in the second form are passed to L<Authen::Htpasswd::User>.
-
-=cut
-
-sub add_user {
- my $self = shift;
- my $user = $self->_get_user(@_);
- my $username = $user->username;
-
- my ($old,$new) = $self->_start_rewrite;
- while (defined(my $line = <$old>)) {
- if ($line =~ /^\Q$username\:/) {
- $self->_abort_rewrite;
- croak "user $username already exists in " . $self->file . "!";
- }
- $self->_print( $new, $line );
- }
- $self->_print( $new, $user->to_line . "\n" );
- $self->_finish_rewrite($old,$new);
-}
-
-=head2 delete_user
-
- $pwfile->delete_user($userobj);
- $pwfile->delete_user($username);
-
-Removes a user entry from the file.
-
-=cut
-
-sub delete_user {
- my $self = shift;
- my $username = $_[0]->isa('Authen::Htpasswd::User') ? $_[0]->username : $_[0];
-
- my ($old,$new) = $self->_start_rewrite;
- while (defined(my $line = <$old>)) {
- next if $line =~ /^\Q$username\:/;
- $self->_print( $new, $line );
- }
- $self->_finish_rewrite($old,$new);
-}
-
-sub _print {
- my ($self,$new,$string) = @_;
- if ( $self->{write_locking} ) {
- print $new $string;
- } else {
- $$new .= $string;
- }
-}
-
-sub _get_user {
- my $self = shift;
- return $_[0] if $_[0]->isa('Authen::Htpasswd::User');
- my $attr = ref $_[-1] eq 'HASH' ? pop @_ : {};
- $attr->{encrypt_hash} ||= $self->encrypt_hash;
- $attr->{check_hashes} ||= $self->check_hashes;
- return Authen::Htpasswd::User->new(@_, $attr);
-}
-
-sub _start_rewrite {
- my $self = shift;
- if ( $self->{write_locking} ) {
- my $old = IO::LockedFile->new($self->file, 'r+') or die $!;
- my $new = IO::File->new($self->file . $SUFFIX, 'w') or die $!;
- return ($old,$new);
- } else {
- my $old = IO::File->new( $self->file, 'r' ) or die $!;
- my $new = "";
- return ($old, \$new);
- }
-}
-
-sub _finish_rewrite {
- my ($self,$old,$new) = @_;
- if ( $self->{write_locking} ) {
- $new->close or die $!;
- rename $self->file . $SUFFIX, $self->file or die $!;
- $old->close or die $!;
- } else {
- $old->close or die $!;
- $old = IO::File->new( $self->file, 'w' ) or die $!;
- print $old $$new;
- $old->close or die $!;
- }
-}
-
-sub _abort_rewrite {
- my ($self,$old,$new) = @_;
- if ( $self->{write_locking} ) {
- $new->close;
- $old->close;
- unlink $self->file . $SUFFIX;
- } else {
- $old->close;
- }
-}
-
-=head1 AUTHOR
-
-David Kamholz C<dkamholz at cpan.org>
-
-Yuval Kogman
-
-=head1 SEE ALSO
-
-L<Apache::Htpasswd>.
-
-=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;
+package Authen::Htpasswd;
+use strict;
+use base 'Class::Accessor::Fast';
+use Carp;
+use IO::LockedFile;
+use Authen::Htpasswd::User;
+
+our $VERSION = '0.15001';
+our $SUFFIX = '.new';
+
+__PACKAGE__->mk_accessors(qw/ file encrypt_hash check_hashes /);
+
+=head1 NAME
+
+Authen::Htpasswd - interface to read and modify Apache .htpasswd files
+
+=head1 SYNOPSIS
+
+ my $pwfile = Authen::Htpasswd->new('user.txt', { encrypt_hash => 'md5' });
+
+ # authenticate a user (checks all hash methods by default)
+ if ($pwfile->check_user_password('bob', 'foo')) { ... }
+
+ # modify the file (writes immediately)
+ $pwfile->update_user('bob', $password, $info);
+ $pwfile->add_user('jim', $password);
+ $pwfile->delete_user('jim');
+
+ # get user objects tied to a file
+ my $user = $pwfile->lookup_user('bob');
+ if ($user->check_password('vroom', [qw/ md5 sha1 /])) { ... } # only use secure hashes
+ $user->password('foo'); # writes to file
+ $user->set(password => 'bar', extra_info => 'editor'); # change more than one thing at once
+
+ # or manage the file yourself
+ my $user = Authen::Htpasswd::User->new('bill', { hashed_password => 'iQ.IuWbUIhlPE' });
+ my $user = Authen::Htpasswd::User->new('bill', 'bar', 'staff', { encrypt_hash => 'crypt' });
+ print PASSWD $user->to_line, "\n";
+
+=head1 DESCRIPTION
+
+This module provides a convenient, object-oriented interface to Apache-style F<.htpasswd> files.
+It supports passwords encrypted via MD5, SHA1, and crypt, as well as plain (cleartext) passwords.
+It requires L<Crypt::PasswdMD5> for MD5 and L<Digest::SHA1> for SHA1. Additional fields after
+username and password, if present, are accessible via the C<extra_info> array.
+
+=head1 METHODS
+
+=head2 new
+
+ my $pwfile = Authen::Htpasswd->new($filename, \%options);
+
+Creates an object for a given F<.htpasswd> file. Options:
+
+=over 4
+
+=item encrypt_hash
+
+How passwords should be encrypted if a user is added or changed. Valid values are C<md5>, C<sha1>,
+C<crypt>, and C<plain>. Default is C<crypt>.
+
+=item check_hashes
+
+An array of hash methods to try when checking a password. The methods will be tried in the order
+given. Default is C<md5>, C<sha1>, C<crypt>, C<plain>.
+
+=back
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $self = ref $_[-1] eq 'HASH' ? pop @_ : {};
+ $self->{file} = $_[0] if $_[0];
+ croak "no file specified" unless $self->{file};
+ if (!-e $self->{file}) {
+ open my $file, '>', $self->{file} or die $!;
+ close $file or die $!;
+ }
+
+ $self->{encrypt_hash} ||= 'crypt';
+ $self->{check_hashes} ||= [ Authen::Htpasswd::Util::supported_hashes() ];
+
+ bless $self, $class;
+}
+
+=head2 lookup_user
+
+ my $userobj = $pwfile->lookup_user($username);
+
+Returns an L<Authen::Htpasswd::User> object for the given user in the password file.
+
+=cut
+
+sub lookup_user {
+ my ($self,$search_username) = @_;
+
+ my $file = IO::LockedFile->new($self->file, 'r') or die $!;
+ while (defined(my $line = <$file>)) {
+ chomp $line;
+ my ($username,$hashed_password, at extra_info) = split /:/, $line;
+ if ($username eq $search_username) {
+ return Authen::Htpasswd::User->new($username,undef, at extra_info, {
+ file => $self,
+ hashed_password => $hashed_password,
+ encrypt_hash => $self->encrypt_hash,
+ check_hashes => $self->check_hashes
+ });
+ }
+ }
+ return undef;
+}
+
+=head2 all_users
+
+ my @users = $pwfile->all_users;
+
+=cut
+
+sub all_users {
+ my $self = shift;
+
+ my @users;
+ my $file = IO::LockedFile->new($self->file, 'r') or die $!;
+ while (defined(my $line = <$file>)) {
+ chomp $line;
+ my ($username,$hashed_password, at extra_info) = split /:/, $line;
+ push(@users, Authen::Htpasswd::User->new($username,undef, at extra_info, {
+ file => $self,
+ hashed_password => $hashed_password,
+ encrypt_hash => $self->encrypt_hash,
+ check_hashes => $self->check_hashes
+ }));
+ }
+ return @users;
+}
+
+=head2 check_user_password
+
+ $pwfile->check_user_password($username,$password);
+
+Returns whether the password is valid. Shortcut for
+C<< $pwfile->lookup_user($username)->check_password($password) >>.
+
+=cut
+
+sub check_user_password {
+ my ($self,$username,$password) = @_;
+ my $user = $self->lookup_user($username);
+ croak "could not find user $username" unless $user;
+ return $user->check_password($password);
+}
+
+=head2 update_user
+
+ $pwfile->update_user($userobj);
+ $pwfile->update_user($username, $password[, @extra_info], \%options);
+
+Modifies the entry for a user saves it to the file. If the user entry does not
+exist, it is created. The options in the second form are passed to L<Authen::Htpasswd::User>.
+
+=cut
+
+sub update_user {
+ my $self = shift;
+ my $user = $self->_get_user(@_);
+ my $username = $user->username;
+
+ my ($old,$new) = $self->_start_rewrite;
+ my $seen = 0;
+ while (defined(my $line = <$old>)) {
+ if ($line =~ /^\Q$username\:/) {
+ chomp $line;
+ my (undef,undef, at extra_info) = split /:/, $line;
+ $user->{extra_info} ||= [ @extra_info ] if scalar @extra_info;
+ print $new $user->to_line, "\n";
+ $seen++;
+ } else {
+ print $new $line;
+ }
+ }
+ print $new $user->to_line, "\n" unless $seen;
+ $self->_finish_rewrite($old,$new);
+}
+
+=head2 add_user
+
+ $pwfile->add_user($userobj);
+ $pwfile->add_user($username, $password[, @extra_info], \%options);
+
+Adds a user entry to the file. If the user entry already exists, an exception is raised.
+The options in the second form are passed to L<Authen::Htpasswd::User>.
+
+=cut
+
+sub add_user {
+ my $self = shift;
+ my $user = $self->_get_user(@_);
+ my $username = $user->username;
+
+ my ($old,$new) = $self->_start_rewrite;
+ while (defined(my $line = <$old>)) {
+ if ($line =~ /^\Q$username\:/) {
+ $self->_abort_rewrite;
+ croak "user $username already exists in " . $self->file . "!";
+ }
+ print $new $line;
+ }
+ print $new $user->to_line, "\n";
+ $self->_finish_rewrite($old,$new);
+}
+
+=head2 delete_user
+
+ $pwfile->delete_user($userobj);
+ $pwfile->delete_user($username);
+
+Removes a user entry from the file.
+
+=cut
+
+sub delete_user {
+ my $self = shift;
+ my $username = $_[0]->isa('Authen::Htpasswd::User') ? $_[0]->username : $_[0];
+
+ my ($old,$new) = $self->_start_rewrite;
+ while (defined(my $line = <$old>)) {
+ next if $line =~ /^\Q$username\:/;
+ print $new $line;
+ }
+ $self->_finish_rewrite($old,$new);
+}
+
+sub _get_user {
+ my $self = shift;
+ return $_[0] if $_[0]->isa('Authen::Htpasswd::User');
+ my $attr = ref $_[-1] eq 'HASH' ? pop @_ : {};
+ $attr->{encrypt_hash} ||= $self->encrypt_hash;
+ $attr->{check_hashes} ||= $self->check_hashes;
+ return Authen::Htpasswd::User->new(@_, $attr);
+}
+
+sub _start_rewrite {
+ my $self = shift;
+ my $old = IO::LockedFile->new($self->file, 'r+') or die $!;
+ my $new = IO::File->new($self->file . $SUFFIX, 'w') or die $!;
+ return ($old,$new);
+}
+
+sub _finish_rewrite {
+ my ($self,$old,$new) = @_;
+ $new->close or die $!;
+ rename $self->file . $SUFFIX, $self->file or die $!;
+ $old->close or die $!;
+}
+
+sub _abort_rewrite {
+ my ($self,$old,$new) = @_;
+ $new->close;
+ $old->close;
+ unlink $self->file . $SUFFIX;
+}
+
+=head1 AUTHOR
+
+David Kamholz C<dkamholz at cpan.org>
+
+Yuval Kogman
+
+=head1 SEE ALSO
+
+L<Apache::Htpasswd>.
+
+=head1 COPYRIGHT & LICENSE
+
+ Copyright (c) 2005 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.
+
+=cut
+
+1;
Modified: trunk/Authen-Htpasswd/t/01use.t
===================================================================
--- trunk/Authen-Htpasswd/t/01use.t 2007-07-15 21:05:01 UTC (rev 6530)
+++ trunk/Authen-Htpasswd/t/01use.t 2007-07-15 21:19:28 UTC (rev 6531)
@@ -1,11 +1,8 @@
#!perl
-use strict;
-BEGIN {
- $| = 1;
- $^W = 1;
-}
-
use Test::More 'no_plan';
-use_ok('Authen::Htpasswd');
+use strict;
+use warnings;
+
+use_ok 'Authen::Htpasswd';
Modified: trunk/Authen-Htpasswd/t/02pod.t
===================================================================
--- trunk/Authen-Htpasswd/t/02pod.t 2007-07-15 21:05:01 UTC (rev 6530)
+++ trunk/Authen-Htpasswd/t/02pod.t 2007-07-15 21:19:28 UTC (rev 6531)
@@ -1,11 +1,3 @@
-#!perl
-
-use strict;
-BEGIN {
- $| = 1;
- $^W = 1;
-}
-
use Test::More;
eval "use Test::Pod 1.14";
Modified: trunk/Authen-Htpasswd/t/03podcoverage.t
===================================================================
--- trunk/Authen-Htpasswd/t/03podcoverage.t 2007-07-15 21:05:01 UTC (rev 6530)
+++ trunk/Authen-Htpasswd/t/03podcoverage.t 2007-07-15 21:19:28 UTC (rev 6531)
@@ -1,11 +1,3 @@
-#!perl
-
-use strict;
-BEGIN {
- $| = 1;
- $^W = 1;
-}
-
use Test::More;
eval "use Test::Pod::Coverage 1.04";
Modified: trunk/Authen-Htpasswd/t/04core.t
===================================================================
--- trunk/Authen-Htpasswd/t/04core.t 2007-07-15 21:05:01 UTC (rev 6530)
+++ trunk/Authen-Htpasswd/t/04core.t 2007-07-15 21:19:28 UTC (rev 6531)
@@ -1,13 +1,9 @@
#!/perl
-use strict;
-BEGIN {
- $| = 1;
- $^W = 1;
-}
-
use Test::More tests => 13;
+use strict;
+use warnings;
use Authen::Htpasswd;
use File::Spec::Functions;
Modified: trunk/Authen-Htpasswd/t/05edit.t
===================================================================
--- trunk/Authen-Htpasswd/t/05edit.t 2007-07-15 21:05:01 UTC (rev 6530)
+++ trunk/Authen-Htpasswd/t/05edit.t 2007-07-15 21:19:28 UTC (rev 6531)
@@ -1,13 +1,10 @@
#!/perl
-use strict;
-BEGIN {
- $| = 1;
- $^W = 1;
-}
-
use Test::More tests => 28;
+use strict;
+use warnings;
+
use Authen::Htpasswd;
use File::Spec::Functions;
More information about the Catalyst-commits
mailing list