File Coverage

lib/NetObj/MacAddress.pm
Criterion Covered Total %
statement 72 72 100.0
branch 24 24 100.0
condition 6 8 75.0
subroutine 21 21 100.0
pod 8 9 88.8
total 131 134 97.7


line stmt bran cond sub pod time code
1 8     8   401391 use strict;
  8         14  
  8         261  
2 8     8   25 use warnings FATAL => 'all';
  8         22  
  8         296  
3 8     8   100 use 5.10.1;
  8         27  
4             package NetObj::MacAddress;
5             $NetObj::MacAddress::VERSION = '1.0.2';
6             # ABSTRACT: represent a MAC address
7              
8 8     8   31 use Carp;
  8         7  
  8         2983  
9              
10             sub _to_binary {
11 39     39   32 my ($macaddr) = @_;
12              
13 39         112 $macaddr =~ s{[-:\.]}{}xmsgi;
14 39 100       130 return unless $macaddr =~ m{\A [\d a-f]{12} \Z}xmsi;
15              
16 29         181 return pack('H2' x 6, unpack('A2' x 6, $macaddr));
17             }
18              
19             sub is_valid {
20 8     8 1 1870 my ($macaddr) = @_;
21 8 100       31 croak 'NetObj::MacAddress::is_valid is a class method only'
22             if ref($macaddr) eq __PACKAGE__;
23              
24 7         10 return !! _to_binary($macaddr);
25             }
26              
27             sub binary {
28 88     88 1 67 my ($self) = @_;
29 88         628 return $self->{binary};
30             };
31              
32             sub BUILDARGS {
33 45     45 0 54 my ($class, $mac, @args) = @_;
34 45 100       94 croak 'no MAC address given' unless defined($mac);
35              
36 44 100       149 if ($mac eq 'binary') {
37 5         6 $mac = shift(@args);
38 5 100       9 if (length($mac) == 6) {
39 1         5 return { binary => $mac };
40             }
41 4         38 croak 'invalid MAC address';
42             }
43 39 100 66     105 if ((ref($mac) eq 'HASH') and exists($mac->{binary}) and (length($mac->{binary}) == 6)) {
      66        
44 1         5 return { binary => $mac->{binary} };
45             }
46 38 100       74 croak 'too many arguments in constructor for ' . __PACKAGE__ if @args;
47              
48 37 100       70 return { binary => $mac->binary() } if ref($mac) eq __PACKAGE__;
49              
50 35 100       143 $mac = _to_binary($mac) unless length($mac) == 6;
51 35 100       102 croak 'invalid MAC address' unless $mac;
52 28         141 return { binary => $mac };
53             }
54              
55             sub new {
56 45     45 1 15052 my ($class, @args) = @_;
57 45         88 return bless BUILDARGS(@_), $class;
58             }
59              
60 8     8   1696 use NetObj::MacAddress::Formatter::Base16;
  8         9  
  8         951  
61             sub to_string {
62 49     49 1 92 my ($self, $format) = @_;
63 49   100     146 $format //= 'base16';
64 49         67 $format = lc($format);
65              
66 49         50 state $formatter = {};
67              
68 49 100       112 if (not exists($formatter->{$format})) {
69 10         21 my $pkg = ucfirst($format);
70 10         48 my $sub = "NetObj::MacAddress::Formatter::${pkg}::format";
71 10 100       49 if (defined(&$sub)) {
72 9         30 $formatter->{$format} = \&$sub;
73             }
74             else {
75 1         14 croak "no formatter for $format";
76             }
77             }
78 48         96 return $formatter->{$format}($self);
79             }
80              
81 8     8   7053 use overload q("") => sub {shift->to_string};
  8     41   5911  
  8         58  
  41         79  
82              
83             use overload q(<=>) => sub {
84 3     3   1348 my ($x, $y) = @_;
85 3         4 return $x->binary() cmp $y->binary()
86 8     8   620 };
  8         57  
  8         47  
87             use overload q(cmp) => sub {
88 5     5   1288 my ($x, $y) = @_;
89 5         10 return "$x" cmp "$y"
90 8     8   585 };
  8         8  
  8         34  
91              
92              
93             # NOTE: vec(EXPR, OFFSET, BITS) treats EXPR as little endian on all platforms
94             # see: perldoc -f vec
95              
96             sub is_unicast {
97 16     16 1 23 my ($self) = @_;
98 16         22 return not vec($self->binary(), 0, 1);
99             }
100              
101             sub is_multicast {
102 8     8 1 9 my ($self) = @_;
103 8         11 return not $self->is_unicast();
104             }
105              
106             sub is_global {
107 16     16 1 27 my ($self) = @_;
108 16         20 return not vec($self->binary(), 1, 1);
109             }
110              
111             sub is_local {
112 8     8 1 10 my ($self) = @_;
113 8         12 return not $self->is_global();
114             }
115              
116             1;
117              
118             __END__
119              
120             =pod
121              
122             =encoding UTF-8
123              
124             =head1 NAME
125              
126             NetObj::MacAddress - represent a MAC address
127              
128             =head1 VERSION
129              
130             version 1.0.2
131              
132             =head1 SYNOPSIS
133              
134             use NetObj::MacAddress;
135              
136             # construct, supports various typical notations
137             my $mac1 = NetObj::MacAddress->new('08:00:20:1e:bc:78');
138             my $mac2 = NetObj::MacAddress->new('08-00-20-1E-BC-78');
139             my $mac3 = NetObj::MacAddress->new('6c40.087c.5e90');
140              
141             # numerical and stringwise comparisons are strictly equivalent
142             $mac1 == $mac2; $mac1 eq $mac2; # true
143             $mac1 != $mac2; $mac1 ne $mac2; # false
144             $mac1 == $mac3; $mac1 eq $mac3; # false
145             $mac1 != $mac3; $mac1 ne $mac3; # true
146              
147             # reject invalid MAC addresses
148             my $invalid_mac = NetObj::MacAddress->new('foo'); # throws exception
149              
150             # test for validity
151             NetObj::MacAddress::is_valid('08:00:20:1e:bc:78'); # true
152             NetObj::MacAddress::is_valid('foo'); # false
153              
154             # allow raw binary MAC addresses (any combination of 6 bytes)
155             my $mac4 = NetObj::MacAddress->new('l@,foo');
156             # specify binary explicitly
157             $mac4 = NetObj::MacAddress->new(binary => 'l@,foo');
158             $mac4 = NetObj::MacAddress->new({binary => 'l@,foo'});
159             # represent as hex (base16)
160             $mac4->to_string(); # '6c402c666f6f'
161             # or as the raw binary
162             $mac4->binary(); # 'l@,foo'
163              
164             =head1 DESCRIPTION
165              
166             NetObj::MacAddress represents MAC addresses. The constructor makes sure that
167             only valid MAC addresses can be instantiated. Two MAC addresses compare equal
168             if they represent the same address independently of the notation used in the
169             constructor.
170              
171             =head1 METHODS
172              
173             =head2 is_valid
174              
175             The class method C<NetObj::MacAddress::is_valid> tests for the validity of a MAC address represented by a string. It does not throw an exception but returns false for an invalid and true for a valid MAC address.
176              
177             =head2 new
178              
179             The constructor expects exactly one argument either as a raw 6 byte value or a
180             string representation in a typically notation of hex characters. It throws an
181             exception for invalid MAC addresses.
182              
183             =head2 binary
184              
185             The C<binary> method returns the raw 6 bytes of the MAC address.
186              
187             =head2 to_string
188              
189             The C<to_string> method returns the MAC address in hex notation (base16). Optionally, if it is given the name of a formatter it will format the string in the corresponding style. The default style is called C<'base16'>.
190              
191             my $mac = NetObj::MacAddress->new('0800201ebc78');
192              
193             $mac->to_string(); # '0800201ebc78'
194             $mac->to_string('base16'); # '0800201ebc78'
195              
196             use NetObj::MacAddress::Formatter::Colons;
197             $mac->to_string('colons'); # '08:00:20:1e:bc:78'
198              
199             use NetObj::MacAddress::Formatter::Dashes;
200             $mac->to_string('dashes'); # '08-00-20-1E-BC-78'
201              
202             use NetObj::MacAddress::Formatter::Dots;
203             $mac->to_string('dots'); # '0800.201e.bc78'
204              
205             Some formatters are available by default (see examples above), others can be
206             added if needed by providing a module with a package name beginning with
207             C<NetObj::MacAddress::Formatter::> similarly to the existing ones.
208              
209             =head2 is_multicast, is_unicast
210              
211             The methods C<is_multicast> and C<is_unicast> indicate whether a MAC address is
212             multicast or unicast, respectively.
213              
214             my $unicast_mac = NetObj::MacAddress->new('000001abcdef');
215             my $multicast_mac = NetObj::MacAddress->new('010001abcdef');
216             $unicast_mac->is_unicast(); # true
217             $unicast_mac->is_multicast(); # false
218             $multicast_mac->is_unicast(); # false
219             $multicast_mac->is_multicast(); # true
220              
221             =head2 is_global, is_local
222              
223             The methods C<is_global> and C<is_local> indicate whether a MAC address is
224             globally or locally assigned, respectively.
225              
226             my $local_mac = NetObj::MacAddress->new('000001abcdef');
227             my $global_mac = NetObj::MacAddress->new('020001abcdef');
228             $local_mac->is_local(); # true
229             $local_mac->is_global(); # false
230             $global_mac->is_local(); # false
231             $global_mac->is_global(); # true
232              
233             =head1 MOTIVATION
234              
235             This class aims to provide a conceptually simple interface to represent a MAC
236             address. The constructor takes a single argument in the form of a string in
237             the most typical hex representations. Exotic representations are not
238             supported. The resulting object is independent of the string representation
239             used to construct it. Two MAC addresses compare equal if the refer to the same
240             bytes.
241              
242             Originally implemented as a Moo class this package is too small to warrant the
243             number of dependencies. It is now implemented as a simple Perl class and
244             strives to have no non CORE dependencies.
245              
246             =for Pod::Coverage BUILDARGS
247              
248             =head1 AUTHOR
249              
250             Elmar S. Heeb <elmar@heebs.ch>
251              
252             =head1 COPYRIGHT AND LICENSE
253              
254             This software is Copyright (c) 2015 by Elmar S. Heeb.
255              
256             This is free software, licensed under:
257              
258             The GNU General Public License, Version 3, June 2007
259              
260             =cut