view release on metacpan or  search on metacpan

lib/Device/OUI.pm  view on Meta::CPAN

    if ( ref $oui ) { return map { hex } split( '-', $oui->norm ) }

    # 00-06-2A or 0:6:2a, etc. any non-hex delimiter will do
    {
        my @parts = grep { length } split( /[^a-f0-9]+/i, $oui );
        if ( @parts == 3 ) { return map { hex } @parts }
    }

    # 00062a, requires exactly 6 hex characters
    {
        my @parts = ( $oui =~ /([a-f0-9])/ig );
        if ( @parts == 6 ) {
            return(
                hex( $parts[0].$parts[1] ),
                hex( $parts[2].$parts[3] ),
                hex( $parts[4].$parts[5] ),
            );
        }
    }
    return ();
}

sub normalize_oui {
    my $oui = shift;
    my @int = oui_to_integers( $oui ) or return;
    return sprintf( '%02X-%02X-%02X', @int );
}

sub normalized { return shift->{ 'oui_norm' } }
*norm = \&normalized;

sub organization { return shift->lookup->{ 'organization' } }
sub company_id { return shift->lookup->{ 'company_id' } }
sub address { return shift->lookup->{ 'address' } }

sub is_private {
    my $self = shift;

    return $self->organization eq 'PRIVATE' ? 1 : 0;
}

sub lookup {
    my $self = shift;

    my $x;
    if ( $x = $self->{ 'lookup' } ) { return $x }

    if ( $x = $self->cache ) { return $self->{ 'lookup' } = $x }
    if ( $x = $self->update_from_file ) { return $self->{ 'lookup' } = $x }
    if ( $x = $self->update_from_web ) { return $self->{ 'lookup' } = $x }
    if ( $self->mirror_file ) {
        if ( $x = $self->update_from_file ) {
            return $self->{ 'lookup' } = $x;
        }
    }

    return $self->{ 'lookup' } = {};
}

sub update_from_file {
    my $self = shift;
    my $oui = $self->norm;

    my $cf = $self->cache_file;
    if ( ! $cf ) { return }
    my $fh = IO::File->new( $cf, 'r' );
    if ( ! $fh ) { return }

    local $/ = "";
            
    while ( my $entry = $fh->getline ) {
        if ( substr( $entry, 0, 8 ) eq $oui ) {
            my $data = $self->parse_oui_entry( $entry );
            $self->cache( $data );
            return $data;
        }
    }
    return;
}

{
    my $HAVE_LWP_SIMPLE;
    sub have_lwp_simple {
        my $self = shift;
        if ( defined $HAVE_LWP_SIMPLE ) { return $HAVE_LWP_SIMPLE }
        eval "require LWP::Simple"; ## no critic
        if ( $@ ) {
            carp "Unable to load LWP::Simple, network access not available\n";
            $HAVE_LWP_SIMPLE = 0;
        } else {
            $HAVE_LWP_SIMPLE = 1;
        }
    }
}

sub mirror_file {
    my $self = shift;
    my $url  = shift || $self->file_url;
    if ( ! $url ) { return }
    my $file = shift || $self->cache_file;
    if ( ! $file ) { return }
    if ( ! $self->have_lwp_simple ) { return }

    my $res = LWP::Simple::mirror( $url, $file );
    if ( $res == LWP::Simple::RC_NOT_MODIFIED() ) { return 0 }
    if ( ! LWP::Simple::is_success( $res ) ) {
        carp "Failed to mirror $url to $file ($res)";
        return;
    }
    return 1;
}

sub get_url {
    my $self = shift;
    my $url = shift;
    if ( ! $url ) { return }

    return LWP::Simple::get( $url );
}

sub load_cache_from_web {
    my $self = shift;
    my $url  = shift || $self->file_url;
    if ( ! $url ) { return }
    my $file = shift || $self->cache_file;
    if ( ! $file ) { return }

    if ( $self->mirror_file( $url, $file ) ) {
        return $self->load_cache_from_file( $file );
    }
    return;
}

sub load_cache_from_file {
    my $self = shift;
    my $file = shift;
    if ( ! $file ) { $file = $self->cache_file }
    if ( ! $file ) { return }

    my $fh = IO::File->new( $file );
    local $/ = "";
    $fh->getline; # dump the header
    my $counter = 0;
    while ( my $entry = $fh->getline ) {
        my $data = $self->parse_oui_entry( $entry );
        $self->cache( $data->{ 'oui' } => $data );
        $counter++;
    }
    return $counter;
}

sub search_url_for {
    my $self = shift;
    my $oui = normalize_oui( shift );
    if ( ! $oui ) { $oui = $self->norm }

    my $url_format = $self->search_url;
    if ( ! $url_format ) { return }

    if ( $url_format =~ /%s/ ) {
        return sprintf( $url_format, $oui );
    } else {
        return $url_format.$oui;
    }
}

sub update_from_web {
    my $self = shift;

    if ( not ref $self ) { return }
    if ( not $self->have_lwp_simple ) { return }

    my $url = $self->search_url_for;
    if ( ! $url ) { return }

    if ( my $page = $self->get_url( $url ) ) {
        if ( $page =~ /listing contains no match/ ) { return }
        my @entries = ( $page =~ m{<pre>(.*?)</pre>}gs );
        if ( @entries > 1 ) { croak "Too many entries returned from $url\n" }
        my $data = $self->parse_oui_entry( shift( @entries ) );
        $self->cache( $data );
        return $data;
    }
    return;
}

sub parse_oui_entry {
    local $_ = pop( @_ ); # pop in case we get called as a class method
use Carp qw( confess );
    if ( ! $_ ) { confess "eh?" }
    s{</?b>}{}g;
    s/\r//g;

    s/\s*\(hex\)\s*/\n/gm;
    s/\s*\(base 16\).*$//gm;
    s/^\s*|\s*$//gsm;

    my %data = ();
    @data{ qw( oui organization company_id address ) } = split( "\n", $_, 4 );
    delete $data{ 'address' } unless $data{ 'address' };
    return \%data;
}

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

    return ( $l[0] <=> $r[0] || $l[1] <=> $r[1] || $l[2] <=> $r[2] );
}

sub dump_cache {
    my $self = shift;

    my @lines = (
        "\n",
        "OUI\t\t\t\tOrganization\n",
        "company_id\t\t\tOrganization\n",
        "\t\t\t\tAddress\n",
        "\n", "\n",
    );

    my $db = $self->cache_handle;

    foreach my $oui ( sort { $a cmp $b } keys %{ $db } ) {
        my $d = { split( "\0", $db->{ $oui } ) };
        my $org = $d->{ 'organization' };