view release on metacpan or  search on metacpan

lib/Net/Domain/Match.pm  view on Meta::CPAN

package Net::Domain::Match;

use strict;

use version; our $VERSION = qv('0.2.3');

our $LOCAL = '/tmp/effective_tld_names.dat';
our $CACHE = '/tmp/effective_tld_names.dat.cache';
our $SOURCE = 'http://mxr.mozilla.org/mozilla-central/source/netwerk/dns/effective_tld_names.dat?raw=1';

use LWP::UserAgent;

sub import {
	if( grep { /:pdata/ } @_ ){
		$SOURCE = 'https://raw.github.com/petermblair/Perl-CPAN/master/Net-Domain-Regex/misc/tld.txt';
	}
}

sub new {
	my $class = shift;

	my $args = {
		local => $LOCAL,
		source => $SOURCE,
		cache => $CACHE,
		@_,
	};

	my $o = bless $args => $class;

	unless( -e $o->{local} ){
		$o->pull;
	}

	$o->refresh;

	return $o;
}

sub insert {
	my $self = shift;
	my $domain = shift;

	my @a = split( /\./, $domain );
	
	if( scalar @a == 2 ){
		$self->{tld}->{"$a[-1]"}++;
		$self->{sld}->{"$domain"}++;
	}
}

sub refresh {
	my $self = shift;

	use open qw(:std :utf8);
	open FD, "<$self->{local}";

	my $tlds = {};
	my $slds = {};

	while( <FD> ){
		chomp;

		if(/^(\S[^\.\s]+)$/){
			$tlds->{$1}++;
		}
		elsif ( /^\S[^\.\s]+\.(.+)$/ && exists $tlds->{$1} ) {
			$slds->{$_}++;
		}
	}

	$self->{tld} = $tlds;
	$self->{sld} = $slds;

	# any manual overrides - not all ccSLD are in the external file
	for( qw/ co.uk / ){
		$self->insert( $_ );
	}

}

sub pull {
	my $self = shift;

	my $ua = LWP::UserAgent->new;
	my $req = HTTP::Request->new( GET => $self->{source} );
	my $res = $ua->request( $req );

	if( $res->is_success ){