File Coverage

blib/lib/NetAddr/MAC.pm
Criterion Covered Total %
statement 319 477 66.8
branch 125 282 44.3
condition 39 64 60.9
subroutine 65 71 91.5
pod 54 54 100.0
total 602 948 63.5


line stmt bran cond sub pod time code
1             #!/bin/false
2             # ABSTRACT: MAC hardware address functions and object (EUI48 and EUI64)
3              
4 7     7   1359765 use strict;
  7         14  
  7         310  
5 7     7   37 use warnings;
  7         11  
  7         444  
6 7     7   105 use v5.10;
  7         26  
7             package NetAddr::MAC;
8             $NetAddr::MAC::VERSION = '1.01';
9              
10 7     7   44 use Carp qw( croak );
  7         13  
  7         546  
11 7     7   42 use Exporter 'import';
  7         12  
  7         278  
12 7     7   39 use List::Util qw( first );
  7         14  
  7         593  
13              
14 7     7   51 use constant EUI48LENGTHHEX => 12;
  7         11  
  7         627  
15 7     7   40 use constant EUI48LENGTHDEC => 6;
  7         45  
  7         1890  
16 7     7   38 use constant EUI64LENGTHHEX => 16;
  7         11  
  7         440  
17 7     7   47 use constant EUI64LENGTHDEC => 8;
  7         9  
  7         47557  
18              
19             our %EXPORT_TAGS;
20              
21             %EXPORT_TAGS = (
22             all => [
23             qw(
24             mac_is_eui48 mac_is_eui64
25             mac_is_unicast mac_is_multicast
26             mac_is_broadcast mac_is_vrrp
27             mac_is_vrrp4 mac_is_vrrp6
28             mac_is_hsrp mac_is_hsrp2
29             mac_is_msnlb
30             mac_is_local mac_is_universal
31             mac_as_basic mac_as_sun
32             mac_as_microsoft mac_as_cisco
33             mac_as_bpr mac_as_ieee
34             mac_as_ipv6_suffix
35             mac_as_tokenring mac_as_singledash
36             mac_as_pgsql
37             )
38             ],
39             properties => [
40             qw(
41             mac_is_eui48 mac_is_eui64
42             mac_is_unicast mac_is_multicast
43             mac_is_broadcast mac_is_vrrp
44             mac_is_vrrp4 mac_is_vrrp6
45             mac_is_hsrp mac_is_hsrp2
46             mac_is_msnlb
47             mac_is_local mac_is_universal
48             )
49             ],
50             normals => [
51             qw(
52             mac_as_basic mac_as_sun
53             mac_as_microsoft mac_as_cisco
54             mac_as_bpr mac_as_ieee
55             mac_as_ipv6_suffix
56             mac_as_tokenring mac_as_singledash
57             mac_as_pgsql
58             )
59             ],
60             );
61              
62             Exporter::export_ok_tags( keys %EXPORT_TAGS );
63              
64              
65             sub new {
66              
67 16     16 1 435562 my ( $p, @q ) = @_;
68              
69             # clear the errstr, see also RT96045
70 16         34 $NetAddr::MAC::errstr = undef;
71              
72 16 100       50 unless (@q) {
73 1         3 my $e = q|Please provide a mac address|;
74 1 50       136 croak "$e\n" if $NetAddr::MAC::die_on_error;
75 0         0 $NetAddr::MAC::errstr = $e;
76             return
77 0         0 }
78              
79 15   33     59 my $c = ref($p) || $p;
80 15         34 my $self = bless {}, $c;
81             # massage a single argument into a mac argument if needed
82 15 50       68 $self->_init( @q % 2 ? ( mac => shift @q, @q ) : @q )
    100          
83             or return;
84              
85 3         8 return $self
86              
87             }
88              
89             {
90              
91             my $_die;
92              
93             sub _init {
94              
95 23     23   97 my ( $self, %args ) = @_;
96              
97 23         213 $_die = undef;
98              
99 23 50       70 if ( defined $args{die_on_error} ) {
100             $_die = ++$self->{_die}
101 0 0       0 if $args{die_on_error};
102             }
103             else {
104             $_die = ++$self->{_die}
105 23 100       75 if $NetAddr::MAC::die_on_error;
106             }
107              
108 23         78 $self->{original} = $args{mac};
109              
110 23 100       89 if ($args{mac} =~ m/^(\d+)\#(.+)$/ ) {
111 1         3 $self->{priority} = $1;
112 1         2 $args{mac} = $2;
113             }
114              
115 23         62 $self->{mac} = _mac_to_integers( $args{mac} );
116              
117 12 100       32 unless ( $self->{mac} ) {
118 1 50       4 croak $NetAddr::MAC::errstr . "\n" if $self->{_die};
119             return
120 1         5 }
121              
122 11 100       25 if (defined $self->{priority}) {
123 1 50 33     4 if ($args{priority} and $args{priority} != $self->{priority}) {
124 0         0 my $e = "Conflicting priority in '$self->{original}' and priority argument $args{priority}";
125 0 0       0 croak "$e\n" if $self->{_die};
126 0         0 $NetAddr::MAC::errstr = $e;
127             return
128 0         0 }
129             }
130             else {
131 10   50     41 $self->{priority} = $args{priority} || 0;
132             }
133              
134             # check none of the list elements are empty
135 11 50   70   34 if (first { not defined $_ or 0 == length $_} @{$self->{mac}}) {
  70 50       337  
  11         33  
136 0         0 my $e = "Invalid MAC format '$self->{original}'";
137 0 0       0 croak "$e\n" if $self->{_die};
138 0         0 $NetAddr::MAC::errstr = $e;
139             return
140 0         0 }
141              
142 11         57 return 1
143              
144             }
145              
146             sub _mac_to_integers {
147              
148 360     360   627 my $mac = shift;
149 360         1018 my $e;
150              
151             CHECK_BLOCK:
152             {
153              
154 360 100       512 unless ($mac) {
  360         754  
155 2         3 $e = 'Please provide a mac address';
156 2         7 last CHECK_BLOCK;
157             }
158              
159             # be nice, strip leading and trailing whitespace
160 358         1393 $mac =~ s/^\s+//;
161 358         844 $mac =~ s/\s+$//;
162              
163 358         680 $mac =~ s{^1,\d,}{}
164             ; # blindly remove the prefix from bpr, we could check that \d is the actual length, but oh well
165              
166             # avoid matching ipv6
167 358 100       1260 last CHECK_BLOCK if $mac =~ m/[a-f0-9]{1,4}:[a-f0-9]{1,4}::([a-f0-9]{1,4})?/i;
168 352 100       886 last CHECK_BLOCK if $mac =~ m/[a-f0-9]{1,4}::[a-f0-9]{1,4}:[a-f0-9]{1,4}/i;
169              
170 349         1924 my @parts = grep { length } split( /[^a-z0-9]+/ix, $mac );
  1242         2518  
171              
172             # anything other than hex...
173 349 100   1209   2374 last CHECK_BLOCK if ( first { m{[^a-f0-9]}i } @parts );
  1209         2391  
174              
175             # resolve wierd things like aabb.cc.00.11.22 or 11.22.33.aabbcc
176             @parts = map {
177 330         1196 my $o = $_;
  1160         1635  
178 1160 100       4645 (length($o) % 2) == 0
179             ? $o =~ m/(..)/g
180             : $o
181             } @parts;
182              
183             # 12 characters for EUI48, 16 for EUI64
184 330 50 33     928 if (
      66        
185             @parts == 1
186             && ( length $parts[0] == EUI48LENGTHHEX
187             || length $parts[0] == EUI64LENGTHHEX )
188             )
189             { # 0019e3010e72
190 0         0 local $_ = shift(@parts);
191 0         0 while (m{([a-f0-9]{2})}igx) { push( @parts, $1 ) }
  0         0  
192 0         0 return [ map { hex($_) } @parts ]
  0         0  
193             }
194              
195             # 00:19:e3:01:0e:72
196 330 100 100     1100 if ( @parts == EUI48LENGTHDEC || @parts == EUI64LENGTHDEC ) {
197 321         520 return [ map { hex($_) } @parts ]
  2090         4481  
198             }
199              
200             # 0019:e301:0e72
201 9 100 66     75 if ( @parts == EUI48LENGTHDEC / 2 || @parts == EUI64LENGTHDEC / 2 )
202             {
203             # it would be nice to accept no leading 0's but this gives
204             # problems detecting broken formatted macs.
205             # cisco doesnt drop leading zeros so lets go for the least
206             # edgey of the edge cases.
207 1 50   1   5 last CHECK_BLOCK if (first {length $_ < 4} @parts);
  1         6  
208              
209             return [
210             map {
211 0 0       0 m{^ ([a-f0-9]{2}) ([a-f0-9]{2}) $}ix
  0         0  
212             && ( hex($1), hex($2) )
213             } @parts
214             ];
215             }
216              
217             }
218              
219 39   66     249 $e ||= "Invalid MAC format '$mac'";
220              
221 39 100       108 if ( defined $_die ) {
    100          
222 11 50       1506 croak "$e\n" if $_die;
223             }
224             elsif ($NetAddr::MAC::die_on_error) {
225 20         2867 croak "$e\n";
226             }
227              
228 8         15 $NetAddr::MAC::errstr = $e;
229              
230             return
231 8         48 }
232              
233             }
234              
235             sub _oui_to_integers {
236 10     10   22 my ( $oui, $min, $max ) = @_;
237              
238 10 50       40 return unless defined $oui;
239              
240             # be nice, strip leading and trailing whitespace
241 10         46 $oui =~ s/^\s+//;
242 10         30 $oui =~ s/\s+$//;
243              
244 10         72 my @parts = grep { length } split( /[^a-z0-9]+/ix, $oui );
  39         106  
245              
246             # anything other than hex...
247 10 50   39   102 return if ( first { m{[^a-f0-9]}i } @parts );
  39         107  
248              
249             @parts = map {
250 10         42 my $o = $_;
  39         67  
251 39 50       165 (length($o) % 2) == 0
252             ? $o =~ m/(..)/g
253             : $o
254             } @parts;
255              
256 10 100 100     70 return unless @parts >= $min && @parts <= $max;
257 8         20 return [ map { hex($_) } @parts ];
  34         82  
258             }
259              
260              
261             sub random {
262              
263 10     10 1 8252 my ( $p, @q ) = @_;
264              
265             # clear the errstr, see also RT96045
266 10         22 $NetAddr::MAC::errstr = undef;
267              
268             # Accept options: oui => ..., eui64 => 1/0
269 10 100       54 my %args = @q % 2 ? ( prefix => shift @q, @q ) : @q;
270 10         25 my $oui_str = $args{prefix};
271              
272 10 50       55 unless ($oui_str) {
273 0         0 my $e = q|Please provide an oui prefix|;
274 0 0 0     0 if ($NetAddr::MAC::die_on_error or $args{_die}) {
275 0         0 croak "$e\n";
276             }
277 0         0 $NetAddr::MAC::errstr = $e;
278             return
279 0         0 }
280              
281 10   100     48 my $eui64 = $args{eui64} // 0;
282 10 100       36 my ($min, $max) = $eui64 ? (4, 7) : (3, 5);
283 10         26 my $oui_ints = _oui_to_integers($oui_str, $min, $max);
284 10 100       33 unless ($oui_ints) {
285 2 100       12 my $e = "Prefix must be between $min and $max octets for ".($eui64 ? 'EUI-64' : 'EUI-48');
286 2 50 33     16 if ($NetAddr::MAC::die_on_error or $args{_die}) {
287 0         0 croak "$e\n";
288             }
289 2         4 $NetAddr::MAC::errstr = $e;
290             return
291 2         8 }
292              
293 8         27 my @mac = (@$oui_ints, map { int(rand(256)) } 1..(1 + $max - scalar(@$oui_ints)));
  18         104  
294              
295             # Compose MAC string for object creation
296 8         18 my $mac_str = join(':', map { sprintf('%02x', $_) } @mac);
  52         145  
297              
298 8   33     39 my $c = ref($p) || $p;
299 8         20 my $self = bless {}, $c;
300 8 50       40 $self->_init( mac => $mac_str )
301             or return;
302              
303 8         49 return $self
304              
305             }
306              
307              
308             sub original {
309              
310 0     0 1 0 my $self = shift;
311             return $self->{original}
312              
313 0         0 }
314              
315              
316             sub oui {
317              
318 1     1 1 213 my $self = shift;
319             return uc join(
320             q{-},
321 3         18 map { sprintf( '%02x', $_ ) }
322 1         2 @{ $self->{mac} }[0 .. 2]
  1         2  
323             );
324              
325             }
326              
327              
328             sub errstr {
329              
330 0     0 1 0 my $self = shift;
331 0 0       0 return $NetAddr::MAC::errstr unless ref $self;
332             return $self->{_errstr}
333              
334 0         0 }
335              
336              
337             sub is_eui48 {
338 200     200 1 289 my $self = shift;
339 200         288 return scalar @{ $self->{mac} } == EUI48LENGTHDEC
  200         2264  
340             }
341              
342              
343             sub is_eui64 {
344 21     21 1 32 my $self = shift;
345 21         23 return scalar @{ $self->{mac} } == EUI64LENGTHDEC
  21         129  
346             }
347              
348              
349             sub is_multicast {
350 15     15 1 21 my $self = shift;
351 15   100     82 return ($self->{mac}->[0] & 1) && ! is_broadcast($self);
352             }
353              
354              
355              
356             sub is_broadcast {
357 22     22 1 57 my $self = shift;
358              
359 22         29 for (@{$self->{mac}}) {
  22         55  
360 32 100       161 return 0 if $_ != 255
361             }
362 2         18 return 1
363             }
364              
365              
366             sub is_vrrp {
367 40     40 1 64 my $self = shift;
368 40   100     89 return is_vrrp4( $self ) || is_vrrp6( $self );
369             }
370              
371              
372             sub is_vrrp4 {
373 44     44 1 62 my $self = shift;
374              
375             return
376             is_eui48($self) &&
377             $self->{mac}->[0] == 0 &&
378             $self->{mac}->[1] == 0 &&
379             $self->{mac}->[2] == hex('0x5e') &&
380             $self->{mac}->[3] == 0 &&
381 44   100     80 $self->{mac}->[4] == 1;
382              
383             }
384              
385              
386             sub is_vrrp6 {
387 36     36 1 54 my $self = shift;
388              
389             return
390             is_eui48($self) &&
391             $self->{mac}->[0] == 0 &&
392             $self->{mac}->[1] == 0 &&
393             $self->{mac}->[2] == hex('0x5e') &&
394             $self->{mac}->[3] == 0 &&
395 36   100     58 $self->{mac}->[4] == 2;
396              
397             }
398              
399              
400             sub is_hsrp {
401 32     32 1 43 my $self = shift;
402              
403             return
404             is_eui48($self) &&
405             $self->{mac}->[0] == 0 &&
406             $self->{mac}->[1] == 0 &&
407             $self->{mac}->[2] == hex('0xc') &&
408             $self->{mac}->[3] == 7 &&
409 32   66     60 $self->{mac}->[4] == hex('0xac');
410              
411             }
412              
413              
414             sub is_hsrp2 {
415 35     35 1 46 my $self = shift;
416              
417             return (
418             is_eui48($self) &&
419             $self->{mac}->[0] == 0 &&
420             $self->{mac}->[1] == 0 &&
421             $self->{mac}->[2] == hex('0xc') &&
422             $self->{mac}->[3] == hex('0x9f') &&
423 35   100     74 $self->{mac}->[4] >= 240 # 0xFX
424             );
425              
426             }
427              
428              
429              
430             sub is_msnlb {
431 32     32 1 49 my $self = shift;
432              
433             return
434             is_eui48($self) &&
435             ($self->{mac}->[0] == 2
436             || $self->{mac}->[0] == 3) &&
437 32   66     64 $self->{mac}->[1] == hex('0xbf')
438              
439             }
440              
441              
442             sub is_unicast {
443 15     15 1 24 my $self = shift;
444 15         93 return ! ($self->{mac}->[0] & 1);
445             }
446              
447              
448             sub is_local {
449 56     56 1 86 my $self = shift;
450 56         359 return $self->{mac}->[0] & 2
451             }
452              
453              
454             sub is_universal {
455 28     28 1 46 my $self = shift;
456 28         64 return !is_local($self)
457             }
458              
459              
460             sub as_basic {
461 6     6 1 10 my $self = shift;
462 6         7 return join( q{}, map { sprintf( '%02x', $_ ) } @{ $self->{mac} } )
  38         119  
  6         16  
463             }
464              
465              
466             sub as_bridge_id {
467 1     1 1 1000 my $self = shift;
468             return $self->{priority}
469 1         3 . '#'
470             . $self->as_cisco;
471             }
472              
473              
474             sub as_bpr {
475 1     1 1 2 my $self = shift;
476             return
477             q{1,}
478 1         4 . scalar @{ $self->{mac} } . q{,}
479 1         2 . join( q{:}, map { sprintf( '%02x', $_ ) } @{ $self->{mac} } );
  6         26  
  1         2  
480             }
481              
482              
483             sub as_cisco {
484 3     3 1 6 my $self = shift;
485             return join( q{.},
486 3         40 map { m{([a-f0-9]{4})}gxi }
487 3         6 join( q{}, map { sprintf( '%02x', $_ ) } @{ $self->{mac} } ) )
  20         47  
  3         8  
488             }
489              
490              
491             sub as_ieee {
492 10     10 1 3586 my $self = shift;
493 10         21 return join( q{:}, map { sprintf( '%02x', $_ ) } @{ $self->{mac} } )
  66         226  
  10         28  
494             }
495              
496              
497             sub as_ipv6_suffix {
498              
499 0     0 1 0 my $self = shift;
500 0         0 my @tmpmac;
501              
502             # be slightly evil here, so that hashrefs and objects work
503 0 0       0 if ( is_eui48($self) ) {
504              
505             # save this for later
506 0         0 @tmpmac = @{ $self->{mac} };
  0         0  
507              
508 0         0 to_eui64($self);
509              
510             }
511              
512 0         0 my @suffix = ( @{ $self->{mac} }[0] ^ 0x02, @{ $self->{mac} }[ 1 .. 7 ] );
  0         0  
  0         0  
513              
514             # restore the eui48 if needed
515 0 0       0 $self->{mac} = \@tmpmac if @tmpmac;
516              
517             return join(
518             q{:},
519             map {
520 0         0 my $i = $_;
  0         0  
521 0         0 $i *= 2;
522 0         0 sprintf( '%02x%02x', $suffix[$i], $suffix[ $i + 1 ] )
523             } 0 .. 3
524             );
525             }
526              
527              
528             sub as_microsoft {
529 1     1 1 2 my $self = shift;
530 1         2 return join( q{-}, map { sprintf( '%02x', $_ ) } @{ $self->{mac} } )
  6         23  
  1         4  
531             }
532              
533              
534             sub as_pgsql {
535 2     2 1 4 my $self = shift;
536              
537             # there may be a better way to do this
538 2         2 my $len = scalar @{ $self->{mac} };
  2         6  
539             return join(
540             q{:},
541             join( '',
542 7         21 map { sprintf( '%02x', $_ ) }
543 2         5 @{ $self->{mac} }[ 0 .. ( $len / 2 - 1 ) ] ),
544             join( '',
545 7         23 map { sprintf( '%02x', $_ ) }
546 2         9 @{ $self->{mac} }[ ( $len / 2 ) .. ( $len - 1 ) ] ),
  2         6  
547             );
548             }
549              
550              
551             sub as_singledash {
552 2     2 1 4 my $self = shift;
553              
554             # there may be a better way to do this
555 2         3 my $len = scalar @{ $self->{mac} };
  2         8  
556             return join(
557             q{-},
558             join( '',
559 7         28 map { sprintf( '%02x', $_ ) }
560 2         6 @{ $self->{mac} }[ 0 .. ( $len / 2 - 1 ) ] ),
561             join( '',
562 7         30 map { sprintf( '%02x', $_ ) }
563 2         11 @{ $self->{mac} }[ ( $len / 2 ) .. ( $len - 1 ) ] ),
  2         7  
564             );
565             }
566              
567              
568             sub as_sun {
569 1     1 1 3 my $self = shift;
570 1         2 return join( q{-}, map { sprintf( '%01x', $_ ) } @{ $self->{mac} } )
  6         22  
  1         4  
571             }
572              
573              
574             sub as_tokenring {
575              
576 3     3 1 6 my $self = shift;
577              
578             return join '-', map {
579 18         26 my $byte = $_;
580 18         23 my $rev = 0;
581 18         88 $rev = ($rev << 1) | ($byte & 1), $byte >>= 1 for 1..8;
582 18         88 sprintf '%02x', $rev
583 3         4 } @{ $self->{mac} };
  3         9  
584             }
585              
586              
587             sub to_eui48 {
588              
589 0     0 1 0 my $self = shift;
590              
591             # be slightly evil here, so that hashrefs and objects work
592 0 0       0 if ( is_eui64($self) ) {
593 0 0 0     0 if ( @{ $self->{mac} }[3] == 0xff
  0   0     0  
594             and
595             ( @{ $self->{mac} }[4] == 0xff or @{ $self->{mac} }[4] == 0xfe ) )
596             {
597              
598             # convert to eui-48
599 0         0 $self->{mac} = [ @{ $self->{mac} }[ 0 .. 2, 5 .. 7 ] ];
  0         0  
600             }
601             else {
602 0         0 my $e = 'eui-64 address is not derived from an eui-48 address';
603 0 0       0 croak "$e\n" if $self->{_die};
604 0         0 $self->{_errstr} = $e;
605             return
606 0         0 }
607             }
608              
609 0         0 return 1
610             }
611              
612              
613             sub to_eui64 {
614              
615 0     0 1 0 my $self = shift;
616              
617             # be slightly evil here so that hashrefs and objects work
618 0 0       0 if ( is_eui48($self) ) {
619              
620             # convert to EUI64
621             $self->{mac} = [
622 0         0 @{ $self->{mac} }[ 0 .. 2 ],
623             0xff,
624             0xfe,
625 0         0 @{ $self->{mac} }[ 3 .. 5 ]
  0         0  
626             ];
627              
628             }
629 0         0 else { return }
630              
631 0         0 return 1
632             }
633              
634              
635             sub mac_is_eui48 {
636              
637 31     31 1 244361 my $mac = shift;
638 31 50       98 croak 'please use is_eui48'
639             if ref $mac eq __PACKAGE__;
640 31 50       68 if ( ref $mac ) {
641 0         0 my $e = 'argument must be a string';
642 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
643 0         0 $NetAddr::MAC::errstr = $e;
644             return
645 0         0 }
646              
647 31 50       72 $mac = _mac_to_integers($mac) or return;
648 21         105 return is_eui48( { mac => $mac } )
649              
650             }
651              
652              
653             sub mac_is_eui64 {
654              
655 31     31 1 28834 my $mac = shift;
656 31 50       92 croak 'please use is_eui64'
657             if ref $mac eq __PACKAGE__;
658 31 50       78 if ( ref $mac ) {
659 0         0 my $e = 'argument must be a string';
660 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
661 0         0 $NetAddr::MAC::errstr = $e;
662             return
663 0         0 }
664              
665 31 50       71 $mac = _mac_to_integers($mac) or return;
666 21         68 return is_eui64( { mac => $mac } )
667              
668             }
669              
670              
671             sub mac_is_multicast {
672              
673 15     15 1 2041 my $mac = shift;
674 15 50       47 croak 'please use is_multicast'
675             if ref $mac eq __PACKAGE__;
676 15 50       53 if ( ref $mac ) {
677 0         0 my $e = 'argument must be a string';
678 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
679 0         0 $NetAddr::MAC::errstr = $e;
680             return
681 0         0 }
682              
683 15 50       39 $mac = _mac_to_integers($mac) or return;
684 15         59 return is_multicast( { mac => $mac } )
685              
686             }
687              
688              
689              
690             sub mac_is_broadcast {
691              
692 15     15 1 442 my $mac = shift;
693 15 50       43 croak 'please use is_broadcast'
694             if ref $mac eq __PACKAGE__;
695 15 50       29 if ( ref $mac ) {
696 0         0 my $e = 'argument must be a string';
697 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
698 0         0 $NetAddr::MAC::errstr = $e;
699             return
700 0         0 }
701              
702 15 50       39 $mac = _mac_to_integers($mac) or return;
703 15         59 return is_broadcast( { mac => $mac } )
704              
705             }
706              
707              
708             sub mac_is_unicast {
709              
710 15     15 1 3136 my $mac = shift;
711 15 50       51 croak 'please use is_unicast'
712             if ref $mac eq __PACKAGE__;
713 15 50       31 if ( ref $mac ) {
714 0         0 my $e = 'argument must be a string';
715 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
716 0         0 $NetAddr::MAC::errstr = $e;
717             return
718 0         0 }
719              
720 15 50       35 $mac = _mac_to_integers($mac) or return;
721 15         83 return is_unicast( { mac => $mac } )
722              
723             }
724              
725              
726             sub mac_is_vrrp {
727              
728 40     40 1 15811 my $mac = shift;
729 40 50       118 croak 'please use is_vrrp'
730             if ref $mac eq __PACKAGE__;
731 40 50       74 if ( ref $mac ) {
732 0         0 my $e = 'argument must be a string';
733 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
734 0         0 $NetAddr::MAC::errstr = $e;
735              
736             return
737 0         0 }
738              
739 40 50       90 $mac = _mac_to_integers($mac) or return;
740 40         188 return is_vrrp( { mac => $mac } )
741              
742             }
743              
744              
745             sub mac_is_vrrp4 {
746              
747 4     4 1 11 my $mac = shift;
748 4 50       12 croak 'please use is_vrrp4'
749             if ref $mac eq __PACKAGE__;
750 4 50       11 if ( ref $mac ) {
751 0         0 my $e = 'argument must be a string';
752 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
753 0         0 $NetAddr::MAC::errstr = $e;
754              
755             return
756 0         0 }
757              
758 4 50       11 $mac = _mac_to_integers($mac) or return;
759 4         16 return is_vrrp4( { mac => $mac } )
760              
761             }
762              
763              
764             sub mac_is_vrrp6 {
765              
766 4     4 1 9 my $mac = shift;
767 4 50       13 croak 'please use is_vrrp6'
768             if ref $mac eq __PACKAGE__;
769 4 50       9 if ( ref $mac ) {
770 0         0 my $e = 'argument must be a string';
771 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
772 0         0 $NetAddr::MAC::errstr = $e;
773              
774             return
775 0         0 }
776              
777 4 50       12 $mac = _mac_to_integers($mac) or return;
778 4         17 return is_vrrp6( { mac => $mac } )
779              
780             }
781              
782              
783             sub mac_is_hsrp {
784              
785 32     32 1 1068 my $mac = shift;
786 32 50       84 croak 'please use is_hsrp'
787             if ref $mac eq __PACKAGE__;
788 32 50       57 if ( ref $mac ) {
789 0         0 my $e = 'argument must be a string';
790 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
791 0         0 $NetAddr::MAC::errstr = $e;
792              
793             return
794 0         0 }
795              
796 32 50       74 $mac = _mac_to_integers($mac) or return;
797 32         111 return is_hsrp( { mac => $mac } )
798              
799             }
800              
801              
802             sub mac_is_hsrp2 {
803              
804 35     35 1 2558 my $mac = shift;
805 35 50       101 croak 'please use is_hsrp2'
806             if ref $mac eq __PACKAGE__;
807 35 50       106 if ( ref $mac ) {
808 0         0 my $e = 'argument must be a string';
809 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
810 0         0 $NetAddr::MAC::errstr = $e;
811              
812             return
813 0         0 }
814              
815 35 50       102 $mac = _mac_to_integers($mac) or return;
816 35         125 return is_hsrp2( { mac => $mac } )
817              
818             }
819              
820              
821             sub mac_is_msnlb {
822              
823 32     32 1 458 my $mac = shift;
824 32 50       89 croak 'please use is_msnlb'
825             if ref $mac eq __PACKAGE__;
826 32 50       59 if ( ref $mac ) {
827 0         0 my $e = 'argument must be a string';
828 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
829 0         0 $NetAddr::MAC::errstr = $e;
830              
831             return
832 0         0 }
833              
834 32 50       75 $mac = _mac_to_integers($mac) or return;
835 32         121 return is_msnlb( { mac => $mac } )
836              
837             }
838              
839              
840             sub mac_is_local {
841              
842 28     28 1 4008 my $mac = shift;
843 28 50       92 croak 'please use is_local'
844             if ref $mac eq __PACKAGE__;
845 28 50       65 if ( ref $mac ) {
846 0         0 my $e = 'argument must be a string';
847 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
848 0         0 $NetAddr::MAC::errstr = $e;
849             return
850 0         0 }
851              
852 28 50       66 $mac = _mac_to_integers($mac) or return;
853 28         146 return is_local( { mac => $mac } )
854              
855             }
856              
857              
858             sub mac_is_universal {
859              
860 28     28 1 7349 my $mac = shift;
861 28 50       94 croak 'please use is_universal'
862             if ref $mac eq __PACKAGE__;
863 28 50       64 if ( ref $mac ) {
864 0         0 my $e = 'argument must be a string';
865 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
866 0         0 $NetAddr::MAC::errstr = $e;
867             return
868 0         0 }
869              
870 28 50       70 $mac = _mac_to_integers($mac) or return;
871 28         136 return is_universal( { mac => $mac } )
872              
873             }
874              
875              
876             sub mac_as_basic {
877              
878 13     13 1 162657 my $mac = shift;
879 13 50       48 croak 'please use as_basic'
880             if ref $mac eq __PACKAGE__;
881 13 50       29 if ( ref $mac ) {
882 0         0 my $e = 'argument must be a string';
883 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
884 0         0 $NetAddr::MAC::errstr = $e;
885             return
886 0         0 }
887              
888 13 100       35 $mac = _mac_to_integers($mac) or return;
889 6         28 return as_basic( { mac => $mac } )
890              
891             }
892              
893              
894             sub mac_as_bpr {
895              
896 1     1 1 4 my $mac = shift;
897 1 50       4 croak 'please use as_basic'
898             if ref $mac eq __PACKAGE__;
899 1 50       4 if ( ref $mac ) {
900 0         0 my $e = 'argument must be a string';
901 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
902 0         0 $NetAddr::MAC::errstr = $e;
903             return
904 0         0 }
905              
906 1 50       4 $mac = _mac_to_integers($mac) or return;
907 1         8 return as_bpr( { mac => $mac } )
908              
909             }
910              
911              
912             sub mac_as_cisco {
913              
914 2     2 1 5 my $mac = shift;
915 2 50       8 croak 'please use as_cisco'
916             if ref $mac eq __PACKAGE__;
917 2 50       5 if ( ref $mac ) {
918 0         0 my $e = 'argument must be a string';
919 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
920 0         0 $NetAddr::MAC::errstr = $e;
921             return
922 0         0 }
923              
924 2 50       6 $mac = _mac_to_integers($mac) or return;
925 2         10 return as_cisco( { mac => $mac } )
926              
927             }
928              
929              
930             sub mac_as_ieee {
931              
932 2     2 1 5 my $mac = shift;
933 2 50       9 croak 'please use as_ieee'
934             if ref $mac eq __PACKAGE__;
935 2 50       6 if ( ref $mac ) {
936 0         0 my $e = 'argument must be a string';
937 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
938 0         0 $NetAddr::MAC::errstr = $e;
939             return
940 0         0 }
941              
942 2 50       7 $mac = _mac_to_integers($mac) or return;
943 2         11 return as_ieee( { mac => $mac } )
944              
945             }
946              
947              
948             sub mac_as_ipv6_suffix {
949              
950 0     0 1 0 my $mac = shift;
951 0 0       0 croak 'please use as_ipv6_suffix'
952             if ref $mac eq __PACKAGE__;
953 0 0       0 if ( ref $mac ) {
954 0         0 my $e = 'argument must be a string';
955 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
956 0         0 $NetAddr::MAC::errstr = $e;
957             return
958 0         0 }
959              
960 0 0       0 $mac = _mac_to_integers($mac) or return;
961 0         0 return as_ipv6_suffix( { mac => $mac } )
962              
963             }
964              
965              
966             sub mac_as_microsoft {
967              
968 1     1 1 3 my $mac = shift;
969              
970 1 50       5 croak 'please use as_microsoft'
971             if ref $mac eq __PACKAGE__;
972 1 50       3 if ( ref $mac ) {
973 0         0 my $e = 'argument must be a string';
974 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
975 0         0 $NetAddr::MAC::errstr = $e;
976             return
977 0         0 }
978              
979 1 50       4 $mac = _mac_to_integers($mac) or return;
980 1         8 return as_microsoft( { mac => $mac } )
981              
982             }
983              
984              
985             sub mac_as_pgsql {
986              
987 2     2 1 5 my $mac = shift;
988              
989 2 50       8 croak 'please use as_pgsql'
990             if ref $mac eq __PACKAGE__;
991 2 50       6 if ( ref $mac ) {
992 0         0 my $e = 'argument must be a string';
993 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
994 0         0 $NetAddr::MAC::errstr = $e;
995             return
996 0         0 }
997              
998 2 50       6 $mac = _mac_to_integers($mac) or return;
999 2         10 return as_pgsql( { mac => $mac } )
1000              
1001             }
1002              
1003              
1004             sub mac_as_singledash {
1005              
1006 2     2 1 7 my $mac = shift;
1007              
1008 2 50       9 croak 'please use as_singledash'
1009             if ref $mac eq __PACKAGE__;
1010 2 50       6 if ( ref $mac ) {
1011 0         0 my $e = 'argument must be a string';
1012 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
1013 0         0 $NetAddr::MAC::errstr = $e;
1014             return
1015 0         0 }
1016              
1017 2 50       25 $mac = _mac_to_integers($mac) or return;
1018 2         14 return as_singledash( { mac => $mac } )
1019              
1020             }
1021              
1022              
1023             sub mac_as_sun {
1024              
1025 1     1 1 3 my $mac = shift;
1026              
1027 1 50       6 croak 'please use as_sun'
1028             if ref $mac eq __PACKAGE__;
1029 1 50       4 if ( ref $mac ) {
1030 0         0 my $e = 'argument must be a string';
1031 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
1032 0         0 $NetAddr::MAC::errstr = $e;
1033             return
1034 0         0 }
1035              
1036 1 50       5 $mac = _mac_to_integers($mac) or return;
1037 1         6 return as_sun( { mac => $mac } )
1038              
1039             }
1040              
1041              
1042             sub mac_as_tokenring {
1043              
1044 3     3 1 9 my $mac = shift;
1045              
1046 3 50       12 croak 'please use as_tokenring'
1047             if ref $mac eq __PACKAGE__;
1048 3 50       8 if ( ref $mac ) {
1049 0         0 my $e = 'argument must be a string';
1050 0 0       0 croak "$e\n" if $NetAddr::MAC::die_on_error;
1051 0         0 $NetAddr::MAC::errstr = $e;
1052             return
1053 0         0 }
1054              
1055 3 50       23 $mac = _mac_to_integers($mac) or return;
1056 3         15 return as_tokenring( { mac => $mac } )
1057              
1058             }
1059              
1060              
1061             1;
1062              
1063             __END__