File Coverage

blib/lib/Net/IP/Route/Reject.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package Net::IP::Route::Reject;
2 1     1   78046 use strict;
  1         3  
  1         52  
3 1     1   6 use Carp;
  1         8  
  1         126  
4 1     1   1372 use IPC::Cmd qw[can_run run];
  1         134509  
  1         81  
5 1     1   6791 use CLASS;
  0            
  0            
6             BEGIN {
7             use Exporter ();
8             use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
9             $VERSION = 0.5;
10             @ISA = qw (Exporter);
11             #Give a hoot don't pollute, do not export more than needed by default
12             @EXPORT = qw ();
13             @EXPORT_OK = qw ();
14             %EXPORT_TAGS = ();
15             }
16              
17              
18             ########################################### main pod documentation begin ##
19             # Below is the documentation for your module.
20              
21             =head1 NAME
22              
23             Net::IP::Route::Reject - Perl module for adding/removing reject routes
24              
25             =head1 SYNOPSIS
26              
27             use Net::IP::Route::Reject
28              
29              
30             =head1 DESCRIPTION
31              
32             Add/remove reject route from route table .
33              
34              
35             =head1 USAGE
36              
37              
38              
39             =head1 BUGS
40              
41              
42              
43             =head1 SUPPORT
44              
45              
46              
47             =head1 AUTHOR
48              
49             Dana Hudes
50             CPAN ID: DHUDES
51             dhudes@hudes.org
52             http://www.hudes.org
53              
54             =head1 COPYRIGHT
55              
56             This program is free software licensed under the...
57              
58             The Artistic License
59              
60             The full text of the license can be found in the
61             LICENSE file included with this module.
62              
63              
64             =head1 SEE ALSO
65              
66             perl(1),IPC::Cmd.
67              
68             =cut
69              
70             ############################################# main pod documentation end ##
71              
72              
73             my $_route_full_path = can_run('route') or die "cannot find the route command";
74             my @_routecmd = ($_route_full_path, qw(add_del addr reject));
75             my $ipv4octetregex = "([0-1]??(1,2)|2[0-4]|25[0-5])";
76             my $ipv4regex = "/^".$ipv4octetregex."\.".$ipv4octetregex."\.".$ipv4octetregex."\.".$ipv4octetregex."\$/o";
77              
78             ################################################ subroutine header begin ##
79              
80             =head2 add
81              
82             Usage : Net::IP::Route::Reject->add('192.168.1.1')
83             Purpose : adds a reject route for the given host from the route table of the host running this
84             Returns : nothing
85             Argument : takes one parameter, a numerical IPv4 address in dotted quad form
86             Throws : Confess on invalid IP address
87             Comments :
88              
89              
90             See Also : Net::IP::Route::Reject->del
91              
92             =cut
93              
94             ################################################## subroutine header end ##
95             sub add {
96             my ($self,$ip)=@_;
97             CLASS->_reject('add',$ip);
98             }
99             ################################################ subroutine header begin ##
100              
101             =head2 del
102              
103             Usage : Net::IP::Route::Reject->del('192.168.1.1')
104             Purpose : removes the reject route for the given host from the route table of the host running this
105             Returns : nothing
106             Argument : takes one parameter, a numerical IPv4 address in dotted quad form
107             Throws : Confess on invalid IP address
108             Comments :
109              
110              
111             See Also : Net::IP::Route::Reject->add
112              
113             =cut
114              
115             ################################################## subroutine header end ##
116              
117             sub del {
118             my ($self,$ip)=@_;
119             CLASS->_reject('del',$ip);
120             }
121             ################################################ subroutine header begin ##
122              
123             =head2 _reject
124              
125             Usage : this is an internal method
126             Purpose : It executes the route command
127             Returns : What it returns
128             Argument : 2 positional parameters: 1st is operation, 2nd is ip address
129             Throws :
130             Comments : This is a private function to avoid checking for bogus operation types
131              
132             See Also : IPC::Cmd
133              
134             =cut
135              
136             ################################################## subroutine header end ##
137             sub _reject {
138             my ($self,$operation, $ip) = @_;
139             carp ("no ip address supplied") unless defined $ip;
140             my @ipaddr = grep $ipv4regex, $ip; #strip out anything that doesn't belong in an ip addres
141             carp ("unsupported operation") unless ($operation eq 'add' ) or ($operation eq 'del');
142             $_routecmd[1]=$operation;
143             $_routecmd[2]=$ipaddr[0];
144            
145             unless (run(command => \@_routecmd, verbose =>0))
146             {
147             my $errmesg = (scalar localtime)." failed to add reject route for $ip (maybe its already listed?)\n ";
148             carp $errmesg;
149             }
150             }
151              
152              
153              
154             1; #this line is important and will help the module return a true value
155             __END__