Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

additional optimization to algorithm

  • Loading branch information...
commit 383c68f7edcce3eddb0301a100e86a2f1ae38d45 1 parent 7626c8e
Richard Simões authored
View
2  Changes
@@ -1,4 +1,6 @@
{{$NEXT}}
+ - Algorithm optimized still further.
+ - Removed rule causing a croak on domains with a leading dot.
v0.1.1 2012-03-11 18:01:25 America/Chicago
- Double speed by using &lc instead of &idn_prep_name
View
2  dist.ini
@@ -3,7 +3,7 @@ author = Richard Simões <rsimoes AT cpan DOT org>
license = LGPL_3_0
copyright_holder = Richard Simões
copyright_year = 2012
-version = v0.1.1
+version = v0.1.2
[@Filter]
-bundle = @Basic
View
57 lib/Mozilla/PublicSuffix.pm
@@ -5,42 +5,39 @@ use warnings FATAL => "all";
use utf8;
use parent "Exporter";
use Carp;
-use Net::LibIDN qw(idn_to_ascii idn_to_unicode);
+use URI::_idna;
our @EXPORT_OK = qw(public_suffix);
# VERSION
# ABSTRACT: Get a domain name's "public suffix" via Mozilla's Public Suffix List
-my %rules = qw();
sub public_suffix {
- my ($domain) = @_;
-
- # Test domain well-formedness:
- $domain = eval { idn_to_unicode idn_to_ascii lc $domain }
- or croak("Argument passed is not a well-formed domain name");
-
- my @labels = split /\./, $domain;
- return exists $rules{$labels[-1]}
- ? do {
- # Gather matching rules:
- my @matches = sort {
- $b->{label} =~ tr/.// <=> $a->{label} =~ tr/.// }
- map {
- my $label = $_ ? join ".", @labels[$_..$#labels] : $domain;
- exists $rules{$label}
- ? { type => $rules{$label}, label => $label }
- : () } 0 .. $#labels;
-
- # Choose prevailing rule and return suffix:
- my ($exc_rule) = grep { $_->{type} eq "e" } @matches;
- $exc_rule
- ? $exc_rule->{label}
- : do {
- my ($type, $label) = @{$matches[0]}{qw(type label)};
- $type eq "w"
- and ($label) = $domain =~ /((?:[^.]+\.)$label)$/;
- $label ||= undef } }
- : undef }
+ my $domain = lc $_[0];
+ index($domain, "xn--") != -1
+ and $domain = eval { URI::_idna::decode($_[0]) };
+
+ return _find_rule($domain, substr($domain, index($domain, ".") + 1 ) ) }
+
+my %rules = qw();
+sub _find_rule {
+ my ($domain, $rhs) = @_;
+ my $drule = $rules{$domain};
+ return defined $drule # Test for rule with full domain
+ ? $drule eq "w"
+ ? undef # Wildcard rules need an extra level.
+ : $domain
+ : $domain eq $rhs
+ ? undef
+ : do {
+ my $rrule = $rules{$rhs};
+ defined $rrule # Test for rule with right-hand side
+ ? $rrule eq "w"
+ ? $domain
+ : $rhs
+ : _find_rule($rhs, substr($rhs, index($rhs, ".") + 1 ) ) } }
+
+1;
+
1;
View
11 lib/Mozilla/PublicSuffix.pod
@@ -33,9 +33,8 @@ list and download/use it if one is found.
=item public_suffix($domain)
-Exported on request. Simply returns the public suffix of the passed argument,
-or C<undef> if the public suffix is not found. Croaks if the passed argument
-is not a well-formed domain name.
+Exported on request. Simply returns the public suffix of the passed domain, or
+C<undef> if a public suffix is not found.
=back
@@ -45,8 +44,8 @@ is not a well-formed domain name.
=item L<Domain::PublicSuffix>
-An alternative to this module, with an object-oriented interface and slightly
-difference interpretation of the rules Mozilla stipulates for determining a
+Similar to this module, with an object-oriented interface and somewhat
+alternative interpretation of the rules Mozilla stipulates for determining a
public suffix.
=back
@@ -55,7 +54,7 @@ public suffix.
Richard Simões C<< <rsimoes AT cpan DOT org> >>
-=head1 COPYRIGHT AND LICENSE
+=head1 COPYRIGHT & LICENSE
Copyright © 2012 Richard Simões. This module is released under the terms of the
L<GNU Lesser General Public License v. 3.0|http://gnu.org/licenses/lgpl.html>
View
2  perlcritic.rc
@@ -1,4 +1,4 @@
severity = 3
verbose = 9
-exclude = ValuesAndExpressions::ProhibitVersionStrings Subroutines::RequireArgUnpacking RegularExpressions::RequireExtendedFormatting Subroutines::ProhibitExplicitReturnUndef BuiltinFunctions::ProhibitComplexMappings
+exclude = ValuesAndExpressions::ProhibitVersionStrings Subroutines::RequireArgUnpacking RegularExpressions::RequireExtendedFormatting Subroutines::ProhibitExplicitReturnUndef BuiltinFunctions::ProhibitComplexMappings ValuesAndExpressions::ProhibitMixedBooleanOperators BuiltinFunctions::RequireBlockMap
include = Variables::ProhibitPackageVars
View
8 t/01-psuffix.t
@@ -13,10 +13,10 @@ is public_suffix("COM"), "com";
is public_suffix("example.COM"), "com";
is public_suffix("WwW.example.COM"), "com";
# Leading dot.
-dies_ok { public_suffix(".com") };
-dies_ok { public_suffix(".example") };
-dies_ok { public_suffix(".example.com") };
-dies_ok { public_suffix(".example.example") };
+is public_suffix(".com"), "com";
+is public_suffix(".example"), undef;
+is public_suffix(".example.com"), "com";
+is public_suffix(".example.example"), undef;
# Unlisted TLD.
is public_suffix("example"), undef;
is public_suffix("example.example"), undef;

0 comments on commit 383c68f

Please sign in to comment.
Something went wrong with that request. Please try again.