File Coverage

blib/lib/Metabrik/Lookup/Oui.pm
Criterion Covered Total %
statement 9 78 11.5
branch 0 30 0.0
condition 0 15 0.0
subroutine 3 9 33.3
pod 1 6 16.6
total 13 138 9.4


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # lookup::oui Brik
5             #
6             package Metabrik::Lookup::Oui;
7 1     1   762 use strict;
  1         2  
  1         30  
8 1     1   5 use warnings;
  1         2  
  1         28  
9              
10 1     1   5 use base qw(Metabrik::File::Text);
  1         1  
  1         449  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable ieee) ],
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             input => 'oui.txt',
25             },
26             commands => {
27             update => [ qw(output|OPTIONAL) ],
28             load => [ qw(input|OPTIONAL) ],
29             from_hex => [ qw(mac_address) ],
30             from_string => [ qw(company_string) ],
31             all => [ ],
32             },
33             require_modules => {
34             'Metabrik::Client::Www' => [ ],
35             },
36             };
37             }
38              
39             sub update {
40 0     0 0   my $self = shift;
41 0           my ($output) = @_;
42              
43 0           my $input = $self->input;
44 0           my $datadir = $self->datadir;
45 0   0       $output ||= $input;
46              
47             # XXX: should also check for generic attribution:
48             # http://www.iana.org/assignments/ethernet-numbers/ethernet-numbers-2.csv
49              
50 0           my $url = 'http://standards-oui.ieee.org/oui.txt';
51              
52 0 0         my $cw = Metabrik::Client::Www->new_from_brik_init($self) or return;
53 0 0         $cw->mirror($url, $output, $datadir) or return;
54              
55 0           return $output;
56             }
57              
58             sub load {
59 0     0 0   my $self = shift;
60 0           my ($input) = @_;
61              
62 0   0       $input ||= $self->datadir.'/'.$self->input;
63 0 0         $self->brik_help_run_file_not_found('load', $input) or return;
64              
65 0           $self->as_array(1);
66              
67 0 0         my $data = $self->read($input) or return;
68              
69 0           return $self->_load($data);
70             }
71              
72             sub from_hex {
73 0     0 0   my $self = shift;
74 0           my ($hex) = @_;
75              
76 0 0         $self->brik_help_run_undef_arg('from_hex', $hex) or return;
77              
78 0   0       my $data = $self->_load || $self->load;
79 0 0         if (! defined($data)) {
80 0           return $self->log->error("from_hex: load failed");
81             }
82              
83 0           my $db = $self->all;
84              
85 0           my @lookup = ();
86 0 0         if (ref($hex) eq 'ARRAY') {
    0          
87 0           for my $h (@$hex) {
88 0           push @lookup, $h;
89             }
90             }
91             elsif (! ref($hex)) {
92 0           push @lookup, $hex;
93             }
94             else {
95 0           return $self->log->error("from_hex: MAC address format not recognized [$hex]");
96             }
97              
98 0           my %result = ();
99 0           for my $hex (@lookup) {
100 0           my $this = $hex;
101 0           $this =~ s/://g;
102 0           $this =~ /^([0-9a-f]{6})/i;
103 0 0         if (exists($db->{$1})) {
104 0           $result{$hex} = $db->{$1};
105             }
106             }
107              
108 0           return \%result;
109             }
110              
111             sub from_string {
112 0     0 0   my $self = shift;
113 0           my ($string) = @_;
114              
115 0 0         $self->brik_help_run_undef_arg('from_string', $string) or return;
116              
117 0   0       my $data = $self->_load || $self->load;
118 0 0         if (! defined($data)) {
119 0           return $self->log->error("from_string: load failed");
120             }
121              
122 0           my @match = ();
123 0           for my $this (@$data) {
124 0           $this =~ s/\r*$//;
125 0 0         if ($this =~ /^\s*([0-9A-F]{2}\-[0-9A-F]{2}\-[0-9A-F]{2})\s+\(hex\)\s+(.*)$/i) {
126 0           $self->log->debug("from_string: this[$this]");
127 0           my $oui = $1;
128 0           my $company = $2;
129 0 0         if ($company =~ /$string/i) {
130 0           $self->log->verbose("from_string: match [$company]");
131 0           $oui =~ s/\-/:/g;
132 0           push @match, lc($oui);
133             }
134             }
135             }
136              
137 0           return \@match;
138             }
139              
140             sub all {
141 0     0 0   my $self = shift;
142              
143 0   0       my $data = $self->_load || $self->load;
144 0 0         if (! defined($data)) {
145 0           return $self->log->error("all: load failed");
146             }
147              
148 0           my %result = ();
149 0           for my $this (@$data) {
150 0           $this =~ s/\r*$//;
151 0 0         if ($this =~ /^\s*([0-9A-F]{6})\s+\(base 16\)\s+(.*)$/i) {
152 0           $self->log->debug("from_hex: this[$this]");
153 0           my $oui = lc($1);
154 0           my $company = $2;
155 0           $result{$oui} = $company;
156             }
157             }
158              
159 0           return \%result;
160             }
161              
162             1;
163              
164             __END__