File Coverage

blib/lib/Metabrik/Lookup/Ipoption.pm
Criterion Covered Total %
statement 9 64 14.0
branch 0 30 0.0
condition 0 12 0.0
subroutine 3 9 33.3
pod 1 6 16.6
total 13 121 10.7


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # lookup::ipoption Brik
5             #
6             package Metabrik::Lookup::Ipoption;
7 1     1   803 use strict;
  1         2  
  1         31  
8 1     1   5 use warnings;
  1         2  
  1         27  
9              
10 1     1   6 use base qw(Metabrik::File::Csv);
  1         3  
  1         547  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable ip option iana) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             datadir => [ qw(datadir) ],
20             input => [ qw(input) ],
21             _load => [ qw(INTERNAL) ],
22             },
23             attributes_default => {
24             separator => ',',
25             input => 'ip-parameters-1.csv',
26             },
27             commands => {
28             update => [ qw(output|OPTIONAL) ],
29             load => [ qw(input|OPTIONAL) ],
30             from_dec => [ qw(dec_number) ],
31             from_hex => [ qw(hex_number) ],
32             from_string => [ qw(ip_option_string) ],
33             },
34             require_modules => {
35             'Metabrik::Client::Www' => [ ],
36             'Metabrik::File::Text' => [ ],
37             },
38             };
39             }
40              
41             sub update {
42 0     0 0   my $self = shift;
43 0           my ($output) = @_;
44              
45 0           my $url = 'http://www.iana.org/assignments/ip-parameters/ip-parameters-1.csv';
46 0           my ($file) = $self->input;
47              
48 0           my $datadir = $self->datadir;
49 0   0       $output ||= $datadir.'/'.$file;
50              
51 0 0         my $cw = Metabrik::Client::Www->new_from_brik_init($self) or return;
52 0 0         my $files = $cw->mirror($url, $file, $datadir) or return;
53 0 0         if (@$files == 0) { # Nothing new
54 0           return $output;
55             }
56              
57             # We have to rewrite the CSV file, cause some entries are multiline.
58 0 0         my $ft = Metabrik::File::Text->new_from_brik_init($self) or return;
59 0           $ft->overwrite(1);
60 0           $ft->append(0);
61 0 0         my $text = $ft->read($output) or return;
62              
63             # Some lines are split on multi-lines, we put into a single line
64             # for each record.
65 0           my @new = split(/\r\n/, $text);
66 0           for (@new) {
67 0           s/\n/ /g;
68             }
69              
70 0           $ft->write(\@new, $output);
71              
72 0           return $output;
73             }
74              
75             sub load {
76 0     0 0   my $self = shift;
77 0           my ($input) = @_;
78              
79 0   0       $input ||= $self->datadir.'/'.$self->input;
80 0 0         $self->brik_help_run_file_not_found('load', $input) or return;
81              
82 0 0         my $data = $self->read($input) or return;
83              
84             # Copy,Class,Number,Value,Name,Reference
85             # 0,0,0,0,EOOL - End of Options List,[RFC791][Jon_Postel]
86              
87 0           return $self->_load($data);
88             }
89              
90             sub from_dec {
91 0     0 0   my $self = shift;
92 0           my ($dec) = @_;
93              
94 0 0         $self->brik_help_run_undef_arg('from_dec', $dec) or return;
95              
96 0   0       my $data = $self->_load || $self->load;
97 0 0         if (! defined($data)) {
98 0           return $self->log->error("from_dec: load failed");
99             }
100              
101 0           for my $this (@$data) {
102 0 0         if ($this->{'Value'} == $dec) {
103 0           return $this->{'Name'};
104             }
105             }
106              
107             # No match
108 0           return 'undef';
109             }
110              
111             sub from_hex {
112 0     0 0   my $self = shift;
113 0           my ($hex) = @_;
114              
115 0 0         $self->brik_help_run_undef_arg('from_hex', $hex) or return;
116              
117 0           my $dec = hex($hex);
118              
119 0           return $self->from_dec($dec);
120             }
121              
122             sub from_string {
123 0     0 0   my $self = shift;
124 0           my ($string) = @_;
125              
126 0 0         $self->brik_help_run_undef_arg('from_string', $string) or return;
127              
128 0   0       my $data = $self->_load || $self->load;
129 0 0         if (! defined($data)) {
130 0           return $self->log->error("from_string: load failed");
131             }
132              
133             # Copy,Class,Number,Value,Name,Reference
134             # 0,0,0,0,EOOL - End of Options List,[RFC791][Jon_Postel]
135              
136 0           my @match = ();
137 0           for my $this (@$data) {
138 0 0         next unless length($this->{'Name'});
139 0           my $name = $this->{'Name'};
140 0 0         if ($name =~ /$string/i) {
141 0           $self->log->verbose("from_string: match with [$name]");
142 0           push @match, $this->{'Value'};
143             }
144             }
145              
146 0           return \@match;
147             }
148              
149             1;
150              
151             __END__