File Coverage

blib/lib/Config/Inetd.pm
Criterion Covered Total %
statement 90 92 97.8
branch 13 16 81.2
condition 3 8 37.5
subroutine 20 20 100.0
pod 7 7 100.0
total 133 143 93.0


line stmt bran cond sub pod time code
1             package Config::Inetd;
2              
3 2     2   100340 use strict;
  2         9  
  2         61  
4 2     2   11 use warnings;
  2         4  
  2         66  
5 2     2   897 use boolean qw(true false);
  2         7029  
  2         10  
6              
7 2     2   163 use Carp qw(croak);
  2         5  
  2         130  
8 2     2   13 use Fcntl qw(O_RDWR LOCK_EX);
  2         4  
  2         85  
9 2     2   1215 use Params::Validate ':all';
  2         24490  
  2         435  
10 2     2   1470 use Tie::File ();
  2         44986  
  2         2474  
11              
12             our ($VERSION, $INETD_CONF);
13              
14             $VERSION = '0.31_01';
15             $INETD_CONF = '/etc/inetd.conf';
16              
17             validation_options(
18             on_fail => sub
19             {
20             my ($error) = @_;
21             chomp $error;
22             croak $error;
23             },
24             stack_skip => 2,
25             );
26              
27             sub new
28             {
29 1     1 1 711 my $class = shift;
30              
31 1   33     11 my $self = bless {}, ref($class) || $class;
32              
33 1         9 $self->_tie_conf(@_);
34 1         61 $self->_parse_enabled;
35              
36 1         19 return $self;
37             }
38              
39             sub _tie_conf
40             {
41 1     1   3 my $self = shift;
42 1         3 my ($conf_file) = @_;
43 1   33     3 $conf_file ||= $INETD_CONF;
44              
45             my $conf_tied = tie(
46 1 50       2 @{$self->{CONF}}, 'Tie::File', $conf_file,
  1         10  
47             mode => O_RDWR, autochomp => false
48             ) or croak "Cannot tie `$conf_file': $!";
49 1 50       221 $conf_tied->flock(LOCK_EX)
50             or croak "Cannot lock `$conf_file': $!";
51             }
52              
53             sub _parse_enabled
54             {
55 1     1   13 my $self = shift;
56              
57 1         9 $self->_filter_conf($self->{CONF});
58              
59 1         920 foreach my $entry (@{$self->{CONF}}) {
  1         6  
60 49         779 my ($serv, $prot) = $self->_extract_serv_prot($entry);
61 49 100       158 $self->{ENABLED}{$serv}{$prot} = $entry !~ /^\#/
62             ? true : false;
63             }
64             }
65              
66             sub is_enabled
67             {
68 2     2 1 908 my $self = shift;
69 2         7 $self->_validate(@_);
70 2         13 my ($serv, $prot) = @_;
71              
72             return exists $self->{ENABLED}{$serv}{$prot}
73 2 50       22 ? $self->{ENABLED}{$serv}{$prot}
74             : undef;
75             }
76              
77             sub enable
78             {
79 1     1 1 7972 my $self = shift;
80 1         4 $self->_validate(@_);
81 1         9 my ($serv, $prot) = @_;
82              
83 1         2 foreach my $entry (@{$self->{CONF}}) {
  1         5  
84 27 100       4287 if ($entry =~ /^ \# .*? $serv .+? $prot \b/x) {
85 1         196 $self->{ENABLED}{$serv}{$prot} = true;
86 1         10 $entry = substr($entry, 1);
87 1         547 return true;
88             }
89             }
90              
91 0         0 return false;
92             }
93              
94             sub disable
95             {
96 1     1 1 7950 my $self = shift;
97 1         15 $self->_validate(@_);
98 1         6 my ($serv, $prot) = @_;
99              
100 1         2 foreach my $entry (@{$self->{CONF}}) {
  1         6  
101 27 100       4331 if ($entry =~ /^ (?!\#) .*? $serv .+? $prot \b/x) {
102 1         190 $self->{ENABLED}{$serv}{$prot} = false;
103 1         10 $entry = "#$entry";
104 1         626 return true;
105             }
106             }
107              
108 0         0 return false;
109             }
110              
111             sub dump_enabled
112             {
113 1     1 1 22 my $self = shift;
114              
115 1         3 my @conf = @{$self->{CONF}};
  1         6  
116 1         7101 $self->_filter_conf(\@conf, qr/^[^\#]/);
117              
118 1         8 return @conf;
119             }
120              
121             sub dump_disabled
122             {
123 1     1 1 4 my $self = shift;
124              
125 1         3 my @conf = @{$self->{CONF}};
  1         5  
126 1         7081 $self->_filter_conf(\@conf, qr/^\#/);
127              
128 1         6 return @conf;
129             }
130              
131             sub config
132             {
133 5     5 1 11831 my $self = shift;
134 5         47 validate_pos(@_);
135              
136 5         55 return $self->{CONF};
137             }
138              
139             sub _filter_conf
140             {
141 3     3   6 my $self = shift;
142 3         7 my ($conf, @regexps) = @_;
143              
144 3         12 unshift @regexps, qr/(?:stream|dgram|raw|rdm|seqpacket)/;
145              
146 3         14 for (my $i = $#$conf; $i >= 0; $i--) {
147 156         14288 foreach my $regexp (@regexps) {
148 254 100 50     953 splice(@$conf, $i, 1) and last
149             unless $conf->[$i] =~ $regexp;
150             }
151             }
152             }
153              
154             sub _extract_serv_prot
155             {
156 49     49   61 my $self = shift;
157 49         106 my ($entry) = @_;
158              
159 49         3175 my ($serv, $prot) = (split /\s+/, $entry)[0,2];
160              
161 49         120 $serv =~ s/.*:(.*)/$1/;
162 49 100       144 $serv = substr($serv, 1) if $serv =~ /^\#/;
163              
164 49         113 return ($serv, $prot);
165             }
166              
167             sub _validate
168             {
169 4     4   9 my $self = shift;
170 4         79 validate_pos(@_, { type => SCALAR }, { type => SCALAR });
171             }
172              
173             DESTROY
174             {
175 1     1   8123 my $self = shift;
176 1         4 untie @{$self->{CONF}};
  1         14  
177             }
178              
179             1;
180             __END__