Device::MAC - Handle hardware MAC Addresses (EUI-48 and EUI-64)

    use Device::MAC;

    my $mac = Device::MAC->new( '00:19:e3:01:0e:72' );
    print $mac->normalized."\n";
    if ( $mac->is_unicast ) {
        print "\tIs Unicast\n";
    } elsif ( $mac->is_multicast ) {
        print "\tIs Multicast\n";
    }
    if ( $mac->is_local ) {
        print "\tIs Locally Administered\n";
    } elsif ( $mac->is_universal ) {
        print "\tIs Universally Administered\n";
        print "\tVendor: ".$mac->oui->organization."\n";
    }

    Ethernet
    802.11 wireless networks
    Bluetooth
    IEEE 802.5 token ring
    FDDI
    ATM

    Firewire
    IPv6
    ZigBee / 802.15.4 wireless personal-area networks

    use Device::MAC qw( ... );

    use Device::MAC ':all';

package Device::MAC;
use strict; use warnings;
our $VERSION = '1.00';
use Moose;
use Device::OUI;
use Carp qw( croak );
use overload (
    '<=>' => 'overload_cmp',
    'cmp' => 'overload_cmp',
    '""'  => 'overload_stringify',
    fallback => 1,
);
use Sub::Exporter -setup => {
    exports => [qw( mac_to_integers normalize_mac mac_cmp )],
};

has 'mac'   => (
    is          => 'rw',
    isa         => 'Str',
    predicate   => 'has_mac',
    clearer     => 'clear_mac',
    required    => 1,
    trigger     => sub {
        my ( $self, $val ) = @_;
        if ( $val ) {
            $self->clear_mac_dependent
        } else {
            $self->clear_mac;
        }
    },
);

sub clear_mac_dependent {
    my $self = shift;

    $self->clear_is_universal;
    $self->clear_is_local;
    $self->clear_is_unicast;
    $self->clear_is_multicast;
    $self->clear_oui;
    $self->clear_is_eui48;
    $self->clear_is_eui64;
}

has 'oui' => ( is => 'rw', isa => 'Maybe[Device::OUI]', lazy_build => 1 );
sub _build_oui {
    my $self = shift;
    ( my $mac = $self->normalized ) =~ s/[^a-f0-9]//ig;
    return Device::OUI->new( substr( $mac, 0, 6 ) );
}

has 'is_eui48'  => ( is => 'ro', isa => 'Bool', lazy_build  => 1 );
sub _build_is_eui48 { return length( shift->normalized ) == 12 }

has 'is_eui64'  => ( is => 'ro', isa => 'Bool', lazy_build  => 1 );
sub _build_is_eui64 { return length( shift->normalized ) == 16 }

has 'is_unicast'   => ( is => 'ro', isa => 'Bool', lazy_build => 1 );
sub _build_is_unicast { ! shift->is_multicast }

has 'is_multicast' => ( is => 'ro', isa => 'Bool', lazy_build => 1 );
sub _build_is_multicast {
    my $self = shift;
    my @bytes = mac_to_integers( $self->mac );
    return $bytes[0] & 1;
}

has 'is_universal'  => ( is => 'ro', isa => 'Bool', lazy_build => 1 );
sub _build_is_universal { ! shift->is_local }

has 'is_local'     => ( is => 'ro', isa => 'Bool', lazy_build => 1 );
sub _build_is_local {
    my $self = shift;
    my @bytes = mac_to_integers( $self->mac );
    return $bytes[0] & 2;
}

sub mac_to_integers {
    my $mac = shift || return;

    my @parts = grep { length } split( /[^a-f0-9]+/i, "$mac" );
    if ( @parts == 1 ) {
        # 12 characters for EUI-48, 16 for EUI-64
        if ( length $parts[0] == 12 || length $parts[0] == 16 ) { # 0019e3010e72
            local $_ = shift( @parts );
            while ( /([a-f0-9]{2})/ig ) { push( @parts, $1 ) }
            return map { hex } @parts;
        }
    } elsif ( @parts == 6 || @parts == 8 ) { # 00:19:e3:01:0e:72
        return map { hex } @parts;
    } elsif ( @parts == 3 || @parts == 4 ) { # 0019:e301:0e72
        return map { /^(\w\w)(\w\w)$/ && ( hex( $1 ), hex( $2 ) ) } @parts;
    } else {
        croak "Invalid MAC format '$mac'";
    }
}

sub normalize_mac {
    my @ints = mac_to_integers( shift );
    croak "MAC must be 6 bytes long for EUI-48 and 8 bytes long for EUI-64"
        unless ( @ints == 6 || @ints == 8 );
    return join( ':', map { sprintf( '%02x', $_ ) } @ints );
}

sub BUILDARGS {
    my $class = shift;
    if ( @_ == 1 && ! ref $_[0] ) { return { mac => shift() } }
    $class->SUPER::BUILDARGS( @_ );
}

sub overload_stringify { return shift->normalized }

sub overload_cmp { return mac_cmp( pop( @_ ) ? reverse @_ : @_ ) }
sub mac_cmp {
    my @l = mac_to_integers( shift );
    my @r = mac_to_integers( shift );

    while ( @l && @r ) {
        if ( $l[0] == $r[0] ) { shift( @l ); shift( @r ); }
        return $l[0] <=> $r[0];
    }
    return 0;
}

has 'normalized'    => ( is => 'rw', isa => 'Maybe[Str]', lazy_build => 1 );
sub _build_normalized { normalize_mac( shift->mac ) }

1;
__END__