File Coverage

blib/lib/DBD/Sys/Plugin/Unix/Groups.pm
Criterion Covered Total %
statement 14 27 51.8
branch 0 6 0.0
condition 0 9 0.0
subroutine 6 7 85.7
pod 3 3 100.0
total 23 52 44.2


line stmt bran cond sub pod time code
1             package DBD::Sys::Plugin::Unix::Groups;
2              
3 3     3   2332 use strict;
  3         5  
  3         82  
4 3     3   14 use warnings;
  3         4  
  3         77  
5 3     3   15 use vars qw($VERSION @colNames);
  3         5  
  3         155  
6              
7 3     3   14 use base qw(DBD::Sys::Table);
  3         4  
  3         1061  
8              
9             $VERSION = "0.102";
10             @colNames = qw(groupname grpass gid members);
11              
12             =pod
13              
14             =head1 NAME
15              
16             DBD::Sys::Plugin::Unix::Groups - provides a table containing operating system user groups
17              
18             =head1 SYNOPSIS
19              
20             $groups = $dbh->selectall_hashref("select * from grent", "groupname");
21              
22             =head1 ISA
23              
24             DBD::Sys::Plugin::Unix::Groups;
25             ISA DBD::Sys::Table
26              
27             =head1 DESCRIPTION
28              
29             This module provides the table I filled the data from the group
30             database C.
31              
32             =head2 COLUMNS
33              
34             =head3 groupname
35              
36             Name of the group
37              
38             =head3 grpass
39              
40             Encrypted password of the group
41              
42             =head3 gid
43              
44             Numerical group id of the users primary group
45              
46             =head3 members
47              
48             Numerical count of the members in this group
49              
50             =head1 METHODS
51              
52             =head2 get_table_name
53              
54             Returns 'grent'.
55              
56             =cut
57              
58 4     4 1 16 sub get_table_name() { return 'grent'; }
59              
60             =head2 get_col_names
61              
62             Returns the column names of the table as named in L
63              
64             =cut
65              
66 2     2 1 10 sub get_col_names() { @colNames }
67              
68             my $havegrent = 0;
69             eval { endgrent(); my @grentry = getgrent(); endgrent(); $havegrent = 1; };
70              
71             =head2 collect_data
72              
73             Retrieves the data from the group database and put it into fetchable rows.
74              
75             =cut
76              
77             sub collect_data()
78             {
79 0     0 1   my %data;
80              
81 0 0         if ($havegrent)
82             {
83 0           setgrent(); # rewind to ensure we're starting fresh ...
84 0           while ( my ( $name, $grpass, $gid, $members ) = getgrent() )
85             {
86 0 0         if ( defined( $data{$name} ) ) # FBSD seems to have a bug with multiple entries
87             {
88 0           my $row = $data{$name};
89 0 0 0       unless ( ( $row->[0] eq $name )
      0        
      0        
90             and ( $row->[1] eq $grpass )
91             and ( $row->[2] == $gid )
92             and ( $row->[3] eq $members ) )
93             {
94 0           warn
95             "$name is delivered more than once and the group information differs from the first one";
96             }
97             }
98             else
99             {
100 0           $data{$name} = [ $name, $grpass, $gid, $members ];
101             }
102             }
103 0           setgrent(); # rewind
104 0           endgrent();
105             }
106              
107 0           my @data = values %data;
108 0           return \@data;
109             }
110              
111             =head1 PREREQUISITES
112              
113             Perl support for the functions getgrent, setgrent, endgrent is required
114             to provide data for the table.
115              
116             =head1 AUTHOR
117              
118             Jens Rehsack Alexander Breibach
119             CPAN ID: REHSACK
120             rehsack@cpan.org alexander.breibach@googlemail.com
121             http://www.rehsack.de/
122              
123             =head1 ACKNOWLEDGEMENTS
124              
125             Some advisories how to implement the data collecting safer and more
126             portable was provided by Ashish SHUKLA .
127              
128             =head1 COPYRIGHT
129              
130             This program is free software; you can redistribute
131             it and/or modify it under the same terms as Perl itself.
132              
133             The full text of the license can be found in the
134             LICENSE file included with this module.
135              
136             =head1 SUPPORT
137              
138             Free support can be requested via regular CPAN bug-tracking system. There is
139             no guaranteed reaction time or solution time, but it's always tried to give
140             accept or reject a reported ticket within a week. It depends on business load.
141             That doesn't mean that ticket via rt aren't handles as soon as possible,
142             that means that soon depends on how much I have to do.
143              
144             Business and commercial support should be acquired from the authors via
145             preferred freelancer agencies.
146              
147             =cut
148              
149             1;