line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# $Id: DBM.pm,v 1.2 2004/07/02 15:07:46 veselosky Exp $ |
2
|
|
|
|
|
|
|
package CGI::Builder::Auth::GroupAdmin::DBM; |
3
|
4
|
|
|
4
|
|
20
|
use vars qw(@ISA $DLM $VERSION); |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
318
|
|
4
|
4
|
|
|
4
|
|
23
|
use strict; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
205
|
|
5
|
4
|
|
|
4
|
|
18
|
use Carp (); |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
2083
|
|
6
|
|
|
|
|
|
|
@ISA = qw(CGI::Builder::Auth::GroupAdmin); |
7
|
|
|
|
|
|
|
$VERSION = (qw$Revision: 1.2 $)[1]; |
8
|
|
|
|
|
|
|
$DLM = " "; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
my %Default = (PATH => ".", |
11
|
|
|
|
|
|
|
DB => ".htgroup", |
12
|
|
|
|
|
|
|
DBMF => "NDBM", |
13
|
|
|
|
|
|
|
NAME => "", |
14
|
|
|
|
|
|
|
FLAGS => "rwc", |
15
|
|
|
|
|
|
|
MODE => 0644, |
16
|
|
|
|
|
|
|
); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub new { |
19
|
0
|
|
|
0
|
1
|
0
|
my($class) = shift; |
20
|
0
|
|
|
|
|
0
|
my $self = bless {%Default, @_}, $class; |
21
|
0
|
|
|
|
|
0
|
$self->_dbm_init; |
22
|
0
|
|
|
|
|
0
|
$self->db($self->{DB}); |
23
|
0
|
|
|
|
|
0
|
return $self; |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
DESTROY { |
27
|
0
|
|
|
0
|
|
0
|
local($^W)=0; |
28
|
0
|
|
|
|
|
0
|
$_[0]->_untie('_HASH'); |
29
|
0
|
|
|
|
|
0
|
$_[0]->unlock; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub add { |
33
|
10
|
|
|
10
|
1
|
17
|
my($self, $username, $group) = @_; |
34
|
10
|
50
|
|
|
|
26
|
$group = $self->{NAME} unless defined $group; |
35
|
10
|
50
|
|
|
|
21
|
return(0, "No group name!") unless defined $group; |
36
|
|
|
|
|
|
|
|
37
|
10
|
50
|
|
|
|
29
|
unless ($self->{'_HASH'}) { |
38
|
0
|
|
|
|
|
0
|
$self->_tie('_HASH', $self->{DB}); |
39
|
|
|
|
|
|
|
} |
40
|
10
|
100
|
|
|
|
34
|
if ($self->{'_HASH'}{$group}) { |
41
|
5
|
50
|
|
|
|
161
|
return (0, "'$username' already in '$group'") if |
42
|
|
|
|
|
|
|
$self->{'_HASH'}{$group} =~ /(^|[$DLM]+)$username([$DLM]+|$)/; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
#for that old .= bug, should be fixed now |
45
|
10
|
|
|
|
|
22
|
my $val = ""; |
46
|
10
|
100
|
|
|
|
32
|
if(defined $self->{'_HASH'}{$group}) { |
47
|
7
|
|
|
|
|
19
|
$val = $self->{'_HASH'}{$group} . $DLM; |
48
|
|
|
|
|
|
|
} |
49
|
10
|
|
|
|
|
14
|
$val .= $username; |
50
|
10
|
|
|
|
|
50
|
$self->{'_HASH'}{$group} = $val; |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub remove { |
54
|
3
|
|
|
3
|
1
|
130
|
my($self,$group) = @_; |
55
|
3
|
50
|
|
|
|
28
|
$group = $self->{NAME} unless defined $group; |
56
|
3
|
|
|
|
|
8
|
delete $self->{'_HASH'}{$group}; |
57
|
3
|
50
|
33
|
|
|
14
|
if($self->{NAME} and $self->{NAME} eq $group) { |
58
|
0
|
|
|
|
|
0
|
delete $self->{NAME}; |
59
|
|
|
|
|
|
|
} |
60
|
3
|
|
|
|
|
10
|
1; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub list { |
64
|
0
|
0
|
|
0
|
1
|
|
return split(/[$DLM]+/, $_[0]->{'_HASH'}{$_[1]}) if $_[1]; |
65
|
0
|
|
|
|
|
|
keys %{$_[0]->{'_HASH'}}; |
|
0
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
package CGI::Builder::Auth::GroupAdmin::DBM::_generic; |
69
|
4
|
|
|
4
|
|
26
|
use vars qw(@ISA); |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
371
|
|
70
|
|
|
|
|
|
|
@ISA = qw(CGI::Builder::Auth::GroupAdmin::DBM); |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
1; |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
__END__ |