File Coverage

blib/lib/Net/ACL/File.pm
Criterion Covered Total %
statement 54 58 93.1
branch 11 26 42.3
condition 6 18 33.3
subroutine 9 9 100.0
pod 3 3 100.0
total 83 114 72.8


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             # $Id: File.pm,v 1.13 2003/06/06 18:45:02 unimlo Exp $
4              
5             package Net::ACL::File;
6              
7 2     2   2934 use strict;
  2         7  
  2         76  
8 2     2   11 use vars qw( $VERSION @ISA );
  2         4  
  2         138  
9              
10             ## Inheritance and Versioning ##
11              
12             @ISA = qw( Net::ACL );
13             $VERSION = '0.07';
14              
15             ## Module Imports ##
16              
17 2     2   11 use Net::ACL;
  2         4  
  2         70  
18 2     2   13 use Net::ACL::Rule qw( :rc :action );
  2         4  
  2         294  
19 2     2   11 use Carp;
  2         4  
  2         115  
20 2     2   981 use Cisco::Reconfig;
  2         26159  
  2         1322  
21              
22             ## Private Global Class Variables ##
23              
24             my %listtypes;
25              
26             ## Public Class Methods ##
27              
28             sub add_listtype
29             {
30 6     6 1 14 my $proto = shift;
31 6   33     42 my $class = ref $proto || $proto;
32 6         12 my ($type,$aclclass,$match,$use) = @_;
33 6   33     29 $use ||= $aclclass;
34 6   33     20 $match ||= $type;
35 6 50       92 unless ($aclclass->isa('Net::ACL::File::Standard'))
36             {
37 0         0 eval "use $use;";
38 0 0       0 croak "Error adding $match ($type) - Can't locate $use module." if ($@ =~ /Can't locate/);
39 0 0       0 croak $@ if ($@);
40 0 0       0 croak "$aclclass is not a Net::ACL::File::Standard class"
41             unless ($aclclass->isa('Net::ACL::File::Standard'))
42             };
43 6         21 $listtypes{$match}->{_class} = $aclclass;
44 6         26 $listtypes{$match}->{_type} = $type;
45             }
46              
47             sub load
48             {
49 12     12 1 1061 my $proto = shift;
50 12   33     65 my $class = ref $proto || $proto;
51 12         19 my $obj = shift;
52 12 50 33     42 unless ((ref $obj) && $obj->isa('Cisco::Reconfig'))
53             {
54 12         46 $obj = Cisco::Reconfig::stringconfig($obj);
55 12 50       8293 croak "Unable to load configuration data" unless $obj;
56             };
57              
58 12         260 my $res;
59              
60 12         73 foreach my $match (sort keys %listtypes)
61             {
62 56         871 my $aclclass = $listtypes{$match}->{_class};
63 56         333 my $lists = $obj->get($match);
64 56 100       9630 foreach my $list ($lists->single ? $lists : $lists->all) # Was get not all
65             {
66 19 50       1123 next if $list->text eq '';
67 19         1933 my $acl = $aclclass->load($list);
68 19 50       49 next unless defined $acl->name; # No list name - no list at all!
69 19         88 $acl->type($listtypes{$match}->{_type});
70 19         48 $res->{$acl->type}->{$acl->name} = $acl;
71             }
72             };
73              
74 12         338 return $res;
75             }
76              
77             ## Public Object Methods ##
78              
79             sub asconfig
80             {
81 18     18 1 6502 my $this = shift;
82 18   33     49 my $class = ref $this || $this;
83 18 50       50 $this = shift if $this eq $class;
84              
85 18         30 my $conf = '';
86 18 50       46 croak 'ACL need name for configuration to be generated' unless defined $this->name;
87 18 50       53 croak 'ACL need type for configuration to be generated' unless defined $this->type;
88 18         24 foreach my $rule (@{$this->{_rules}})
  18         47  
89             {
90 28 50       165 croak "ACL rule of class " . (ref $rule) . " has no asconfig method!" unless $rule->can('asconfig');
91 28         70 $conf .= $rule->asconfig($this->name,$this->type);
92             };
93 18         70 return $conf;
94             }
95              
96             ## POD ##
97              
98             =pod
99              
100             =head1 NAME
101              
102             Net::ACL::File - Access-lists constructed from configuration file like syntax.
103              
104             =head1 SYNOPSIS
105              
106             use Net::ACL::File;
107              
108             Net::ACL::File->add_listtype('community-list', __PACKAGE__,'ip community-list');
109              
110             # Construction
111             $config = "ip community-list 4 permit 65001:1\n";
112             $list_hr = load Net::ACL::File($config);
113              
114             $list = renew Net::ACL(Type => 'community-list', Name => 4);
115             $config = $list->asconfig;
116              
117             =head1 DESCRIPTION
118              
119             This module extends the Net::ACL class with a load constructor that loads one
120             or more objects from a Cisco-like configuration file using Cisco::Reconfig.
121              
122             =head1 CONSTRUCTOR
123              
124             =over 4
125              
126             =item load() - Load one or more Net::ACL objects from a configuration string.
127              
128             $list_hr = load Net::ACL::File($config);
129              
130             This special constructor parses a Cisco-like router configuration.
131              
132             The constructor takes one argument which should either be a string or a
133             Cisco::Reconfig object.
134              
135             It returns a hash reference. The hash is indexed on
136             list-types. Currently supporting the following:
137              
138             =over 4
139              
140             =item C
141              
142             =item C
143              
144             =item C
145              
146             =item C
147              
148             =item C
149              
150             =back
151              
152             Each list-type hash value contains a new hash reference indexed on list names
153             or numbers.
154              
155             =back
156              
157             =head1 CLASS METHODS
158              
159             =over 4
160              
161             =item add_listtype()
162              
163             The add_listtype() class method registers a new class of access-lists.
164              
165             The first argument is the type-string of the new class.
166             The second argument is the class to be registered. The class should be a
167             sub-class of Net::BGP::File::Standard. Normally this should be C<__PACKAGE__>.
168              
169             The third argument is used to match the lines in the configuration file using
170             Cisco::Reconfig's get() method. If match argument is not defined,
171             the type string will be used.
172              
173             The forth argument is used to load the class with a "use" statement. This
174             should only be needed if the class is located in a different package.
175             Default is the class name from the second argument.
176              
177             =back
178              
179             =head1 ACCESSOR METHODS
180              
181             =over 4
182              
183             =item asconfig()
184              
185             This function tries to generate a configuration matching the one the load
186             constructer got. It can read from any access-list. The resulting configuration
187             is returned as a string.
188              
189             All ACL's which rules support the I method may be used. To do so,
190             use:
191              
192             $conf = Net::ACL::File->asconfig($acl);
193              
194             =back
195              
196             =head1 SEE ALSO
197              
198             Net::ACL, Cisco::Reconfig, Net::ACL::File::Standard
199              
200             =head1 AUTHOR
201              
202             Martin Lorensen
203              
204             =cut
205              
206             ## End Package Net::ACL::File ##
207              
208             1;