File Coverage

blib/lib/NetAddr/MAC.pm
Criterion Covered Total %
statement 274 431 63.5
branch 103 252 40.8
condition 23 47 48.9
subroutine 60 67 89.5
pod 50 50 100.0
total 510 847 60.2


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