Net::Domain::TldMozilla - TLD of the Mozilla source is returned.

Net-SPAMerLookup documentation Contained in the Net-SPAMerLookup distribution.

Index

Code Index:

NAME

Top

Net::Domain::TldMozilla - TLD of the Mozilla source is returned.

SYNOPSIS

Top

  use Net::Domain::TldMozilla;

  my @Tld= Net::Domain::TldMozilla->get;

DESCRIPTION

Top

TLD is acquired and returned from the source open to the public on the Mozilla site.

Please set HTTP_PROXY of the environment variable if you use Proxy.

  $ENV{HTTP_PROXY}= '192.168.0.1:8080';

METHODS

Top

get_tld

The list of TLD is returned.

  my $TLD= Net::Domain::TldMozilla->get;

ENVIRONMENT VARIABLE

Top

The following environment variables are treated.

* TLD_MOZILLA_URL

So that URL of the Mozilla site may change.

* TLD_MOZILLA_TEMP

Passing preservation of cache file ahead.

Default is '/tmp'.

SEE ALSO

Top

LWP::Simple, File::Slurp, Jcode,

AUTHOR

Top

Masatoshi Mizuno <lushe(&64;)cpan.org>

COPYRIGHT AND LICENSE

Top

Copyright (C) 2008 by Bee Flag, Corp. <http://egg.bomcity.com/>.

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available.

Net-SPAMerLookup documentation Contained in the Net-SPAMerLookup distribution. 
package Net::Domain::TldMozilla;
#
# Masatoshi Mizuno E<lt>lusheE(<64>)cpan.orgE<gt>
#
# $Id: TldMozilla.pm 375 2009-01-22 06:17:35Z lushe $
#
use strict;
use warnings;
use LWP::Simple;
use File::Slurp;
use Jcode;

our $VERSION = '0.03';

our $SOURCE_URL= 'http://mxr.mozilla.org/firefox/source/netwerk/dns/src/effective_tld_names.dat?raw=1';

sub get_tld {
#
# ------------------------------------------------------------------------------------------
my $span= $ENV{TLD_MOZILLA_DOWN_SPAN} || 3;
my $url = $ENV{TLD_MOZILLA_URL} || $SOURCE_URL;
my $temp= ($ENV{TLD_MOZILLA_TEMP} || '/tmp'). '/mozilla_tld.cache';
# ------------------------------------------------------------------------------------------
#
	my $TLD= do {
		my $read= sub { my $plain= read_file($temp); [ split /\s*\n\s*/, $plain ] };
		(! -e $temp or (-M _)> $span) ? do {
			if (my $source= LWP::Simple::get($url)) {
				my @tld;
				for (split /\n/, $source) {
					next if (! $_ or /^\s*(?:\/|\#)/);
					my $icode= Jcode::getcode(\$_) || next;
					next if $icode ne 'ascii';
					s/^\s*\*\.?//;
					s/^\s*\!\s*\.?//;
					push @tld, $_;
				}
				write_file($temp, ( join("\n", @tld) || '' ));
				warn __PACKAGE__. " - data save. [$temp]";
				\@tld;
			} else {
				-e $temp ? do {
					warn __PACKAGE__. " - Unable to get document: $!";
					$read->();
				  }: do {
					die __PACKAGE__. " - Unable to get document: $!";
				  };
			}
		  }: do {
			$read->();
		  };
	  };
	wantarray ? @$TLD: $TLD;
}

1;

__END__