view release on metacpan or  search on metacpan

lib/Net/MAC/Vendor.pm  view on Meta::CPAN

	return \@lines;
	}

#pod =item oui_url
#pod
#pod =item oui_urls
#pod
#pod Returns the URLs of the oui.txt resource. The IEEE likes to move this
#pod around. These are the default URL that C<load_cache> will use, but you
#pod can also supply your own with the C<NET_MAC_VENDOR_OUI_URL> environment
#pod variable.
#pod
#pod =cut

sub oui_url { (grep { /\Ahttp:/ } &oui_urls)[0] }

sub oui_urls {
	my @urls = 'http://standards-oui.ieee.org/oui.txt';

	unshift @urls, $ENV{NET_MAC_VENDOR_OUI_URL}
		if defined $ENV{NET_MAC_VENDOR_OUI_URL};

	@urls;
	}

#pod =item load_cache( [ SOURCE[, DEST ] ] )
#pod
#pod Downloads the current list of all OUIs in SOURCE, parses it with
#pod C<parse_oui()>, and stores it in the cache. The C<fetch_oui()> will
#pod use this cache if it exists.
#pod
#pod By default, this uses the URL from C<oui_url>, but given an argument,
#pod it tries to use that.
#pod
#pod If the url indicates that the data is compressed, the response content
#pod is decompressed before being stored.
#pod
#pod If C<load_cache> cannot load the data, it issues a warning and returns
#pod nothing.
#pod
#pod This previously used DBM::Deep if it was installed, but that was much
#pod too slow. Instead, if you want persistence, you can play with
#pod C<$Net::MAC::Vendor::Cached> yourself.
#pod
#pod If you want to store the data fetched for later use, add a destination
#pod filename to the request. To fetch from the default location and store,
#pod specify C<undef> as source.
#pod
#pod =cut

sub load_cache {
	my( $source, $dest ) = @_;

	my $data = do {;
		if( defined $source ) {
			unless( -e $source ) {
				Carp::carp "Net::Mac::Vendor cache source [$source] does not exist";
				return;
				}

			do { local( *ARGV, $/ ); @ARGV = $source; <> }
			}
		else {
			#say time . " Fetching URL";
			my $url = oui_url();
			my $tx = __PACKAGE__->ua->get( $url );
			#say time . " Fetched URL";
			#say "size is " . $tx->res->headers->header( 'content-length' );
			($url =~ /\.bz2/) ? _bunzip($tx->res->body) :
			($url =~ /\.gz/)  ? _gunzip($tx->res->body) :
			                    $tx->res->body;
			}
		};

	if( defined $dest ) {
		if( open my $fh, '>:utf8', $dest ) {
			print { $fh } $data;
			close $fh;
			}
		else { # notify on error, but continue
			Carp::carp "Could not write to '$dest': $!";
			}
		}


	# The PRIVATE entries fill in a template with no
	# company name or address, but the whitespace is
	# still there. We need to split on a newline
	# followed by some potentially horizontal whitespace
	# and another newline
	my $CRLF = qr/(?:\r?\n)/;
	my @entries = split /[\t ]* $CRLF [\t ]* $CRLF/x, $data;
	shift @entries;

	my $count = '';
	foreach my $entry ( @entries ) {
		$entry =~ s/^\s+//;
		my $oui = substr $entry, 0, 8;
		__PACKAGE__->add_to_cache( $oui, parse_oui( $entry ) );
		}

	return 1;
	}

sub _bunzip {
	my $content = shift;
	if (eval { +require Compress::Bzip2; 1 }) {
		return Compress::Bzip2::memBunzip($content);
		}
	else {
		require File::Temp;
		my ($tempfh, $tempfilename) = File::Temp::tempfile( UNLINK => 1 );
		binmode $tempfh, ':raw';
		print $tempfh $content;
		close $tempfh;

		open my $unzipfh, "bunzip2 --stdout $tempfilename |"
			or die "cannot pipe to bunzip2: $!";
		local $/;
		return <$unzipfh>;
		}