CGI-Builder-Auth
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
lib/CGI/Builder/Auth/UserAdmin/DBM.pm view on Meta::CPAN
# $Id: DBM.pm,v 1.1.1.1 2004/06/28 19:24:28 veselosky Exp $
package CGI::Builder::Auth::UserAdmin::DBM;
use CGI::Builder::Auth::UserAdmin ();
use Carp ();
use strict;
use vars qw(@ISA $VERSION);
@ISA = qw(CGI::Builder::Auth::UserAdmin);
$VERSION = (qw$Revision: 1.1.1.1 $)[1];
my %Default = (PATH => ".",
DB => ".htpasswd",
DBMF => "NDBM",
FLAGS => "rwc",
MODE => 0644,
);
sub new {
my($class) = shift;
my $self = bless { %Default, @_ } => $class;
$self->_dbm_init;
$self->db($self->{DB});
return $self;
}
sub DESTROY {
local($^W)=0;
$_[0]->_untie('_HASH');
$_[0]->unlock;
}
sub add {
my($self, $user, $passwd, @rest) = @_;
return(0, "add_user: no user name!") unless $user;
return(0, "add_user: no password!") unless defined($passwd);
return(0, "user '$user' exists in $self->{DB}")
if $self->exists($user);
local($^W) = 0; #shutup uninit warnings
if (ref($rest[0]) eq 'HASH') {
my $f = $rest[0];
@rest = ();
foreach (keys %{$f}) { push(@rest,"$_="._escape($f->{$_})); }
}
my $dlm = ":";
$dlm = $self->{DLM} if defined $self->{DLM};
my $pass = $self->encrypt($passwd);
$self->{'_HASH'}{$user} = $pass . (@rest ? ($dlm . join($dlm,@rest)) : "");
1;
}
sub fetch {
my($self,$username,@fields) = @_;
return(0, "fetch: no user name!") unless $username;
return(0, "fetch: user '$username' doesn't exist")
unless my $val = $self->exists($username);
my (%f);
foreach (@fields) {
grep($f{$_}++,ref($_) ? @$_ : $_);
}
my(@bits) = split(':',$val);
if ($self->{ENCRYPT} eq 'MD5') {
splice(@bits,0,3);
} else {
shift(@bits);
}
my %r;
foreach (@bits) {
my($n,$v) = split('=');
$r{$n}=_unescape($v) if $f{$n};
}
return \%r;
}
# Extended _escape to process control characters too [CJD]
# sub _escape { $_=shift; s/([,=:])/uc sprintf("%%%02x",ord($1))/ge; return $_; }
sub _escape { $_=shift; s/([\000-\037,=:%])/uc sprintf("%%%02x",ord($1))/ge; return $_; }
sub _unescape { $_=shift; s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge; return $_; }
package CGI::Builder::Auth::UserAdmin::DBM::_generic;
view all matches for this distributionview release on metacpan - search on metacpan
( run in 0.741 second using v1.00-cache-2.02-grep-82fe00e-cpan-503542c4f10 )