File Coverage

blib/lib/CGI/Builder/Auth/GroupAdmin/DBM.pm
Criterion Covered Total %
statement 28 41 68.2
branch 10 18 55.5
condition 1 3 33.3
subroutine 6 9 66.6
pod 4 4 100.0
total 49 75 65.3


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__