[Catalyst-commits] r6530 - 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:05:02 GMT 2007
Author: adamk
Date: 2007-07-15 22:05:01 +0100 (Sun, 15 Jul 2007)
New Revision: 6530
Added:
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:
Making write locking optional, making the dependencies compulsory, and converting to EU:MM so that life on Windows will rock.
Modified: trunk/Authen-Htpasswd/Changes
===================================================================
--- trunk/Authen-Htpasswd/Changes 2007-07-15 21:04:09 UTC (rev 6529)
+++ trunk/Authen-Htpasswd/Changes 2007-07-15 21:05:01 UTC (rev 6530)
@@ -1,25 +1,29 @@
-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.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
Added: trunk/Authen-Htpasswd/Makefile.PL
===================================================================
--- trunk/Authen-Htpasswd/Makefile.PL (rev 0)
+++ trunk/Authen-Htpasswd/Makefile.PL 2007-07-15 21:05:01 UTC (rev 6530)
@@ -0,0 +1,21 @@
+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,
+ },
+
+);
Added: trunk/Authen-Htpasswd/README
===================================================================
--- trunk/Authen-Htpasswd/README (rev 0)
+++ trunk/Authen-Htpasswd/README 2007-07-15 21:05:01 UTC (rev 6530)
@@ -0,0 +1,99 @@
+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:04:09 UTC (rev 6529)
+++ trunk/Authen-Htpasswd/lib/Authen/Htpasswd/User.pm 2007-07-15 21:05:01 UTC (rev 6530)
@@ -5,6 +5,11 @@
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:04:09 UTC (rev 6529)
+++ trunk/Authen-Htpasswd/lib/Authen/Htpasswd/Util.pm 2007-07-15 21:05:01 UTC (rev 6530)
@@ -1,11 +1,15 @@
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:04:09 UTC (rev 6529)
+++ trunk/Authen-Htpasswd/lib/Authen/Htpasswd.pm 2007-07-15 21:05:01 UTC (rev 6530)
@@ -1,282 +1,328 @@
-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;
+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;
Modified: trunk/Authen-Htpasswd/t/01use.t
===================================================================
--- trunk/Authen-Htpasswd/t/01use.t 2007-07-15 21:04:09 UTC (rev 6529)
+++ trunk/Authen-Htpasswd/t/01use.t 2007-07-15 21:05:01 UTC (rev 6530)
@@ -1,8 +1,11 @@
#!perl
+use strict;
+BEGIN {
+ $| = 1;
+ $^W = 1;
+}
+
use Test::More 'no_plan';
-use strict;
-use warnings;
-
-use_ok 'Authen::Htpasswd';
+use_ok('Authen::Htpasswd');
Modified: trunk/Authen-Htpasswd/t/02pod.t
===================================================================
--- trunk/Authen-Htpasswd/t/02pod.t 2007-07-15 21:04:09 UTC (rev 6529)
+++ trunk/Authen-Htpasswd/t/02pod.t 2007-07-15 21:05:01 UTC (rev 6530)
@@ -1,3 +1,11 @@
+#!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:04:09 UTC (rev 6529)
+++ trunk/Authen-Htpasswd/t/03podcoverage.t 2007-07-15 21:05:01 UTC (rev 6530)
@@ -1,3 +1,11 @@
+#!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:04:09 UTC (rev 6529)
+++ trunk/Authen-Htpasswd/t/04core.t 2007-07-15 21:05:01 UTC (rev 6530)
@@ -1,9 +1,13 @@
#!/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:04:09 UTC (rev 6529)
+++ trunk/Authen-Htpasswd/t/05edit.t 2007-07-15 21:05:01 UTC (rev 6530)
@@ -1,10 +1,13 @@
#!/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