Group :: Development/Perl
RPM: perl-Data-Validate-Domain
Navigation
Main Changelog Spec Patches Sources Download Gear Bugs and FR Repocop
pax_global_header 0000666 0000000 0000000 00000000064 12271076321 0014513 g ustar 00root root 0000000 0000000 52 comment=fbd438f250bbd7728481bac5ab94f1e1d4e0a73e
Data-Validate-Domain-0.10/ 0000755 0000000 0000000 00000000000 12271076321 0015236 5 ustar 00root root 0000000 0000000 Data-Validate-Domain-0.10/Changes 0000644 0000000 0000000 00000004267 12271076321 0016542 0 ustar 00root root 0000000 0000000 Revision history for Perl extension Data::Validate::Domain.
0.10 Mon Dec 29 2010
- Fixed bug 41033, no longer allows \n in domain_labels
Thanks to marek.miska@netart.pl for reporting the bug
0.09 Mon Feb 18 2008
- Added new option of domain_allow_underscore to allow this module
to be used for validating domainnames like _spf.neely.cx if the option is set
Default behavior was not changed
0.08 Wed May 17 2007
- Ugh, forgot to add new tests to MANIFEST
0.07 Wed May 17 2007
- Added POD testing, and minor cleanup related to that
0.06 Wed May 16 2007
- Updated contact information to be neil@neely.cx, this is a purely cosmetic change
0.05 Fri Dec 04 14:03:58 2006
- Added Support for compiled regular expressions to the private_domain_tld option.
- Thanks to Berhhard Graf <graf@augensalat.de> for the suggestion.
0.04 Fri Dec 01 10:21:04 2006
- Added support for options to alter behavior of is_domain with these new
options is_domain will be able to work with private domains with custom TLD's.
- Special Thanks to Len Reed <lreed@levanta.com> for not only suggesting
the need for this but supplying several patches to help steer this
solution in the right direction. Also made several documentation
improvements.
- Additional thanks to Richard Sonnen <sonnen@richardsonnen.com> for
helping flush out the details of how to utilize options in the
Data::Validate name space portably.
0.03 Thu Nov 03 07:47:21 2005
- Updated to support new procedural version of Net::Domain::TLD
- Thanks to Ricardo Signes <rjbs@cpan.org> for letting me know about his new interface
0.02 Fri Oct 28 12:46:51 2005
- added is_hostname method (which is valid for either somehost or somehost.domain.com)
- modified is_domain to verify TLD of domain supplied (Uses Net::Domain::TLD)
- Fixed bug that allowed domain.com... to return the same results as domain.com
- Will no longer consider domain.com. to be valid
Thanks to Smylers <smylers@donhost.co.uk> for the detailed bug
report and suggested fixes.
0.01 Fri Mar 4 10:56:34 2005
- original version; created by h2xs 1.23 with options
-AXn Data::Validate::Domain
Data-Validate-Domain-0.10/MANIFEST 0000644 0000000 0000000 00000000301 12271076321 0016361 0 ustar 00root root 0000000 0000000 Changes
Makefile.PL
MANIFEST
README
t/Data-Validate-Domain.t
t/Pod.t
t/Pod-Coverage.t
lib/Data/Validate/Domain.pm
META.yml Module meta-data (added by MakeMaker)
Data-Validate-Domain-0.10/META.yml 0000644 0000000 0000000 00000001025 12271076321 0016505 0 ustar 00root root 0000000 0000000 --- #YAML:1.0
name: Data-Validate-Domain
version: 0.10
abstract: domain validation methods
author:
- Neil Neely <neil@neely.cx>
license: perl
distribution_type: module
configure_requires:
ExtUtils::MakeMaker: 0
requires:
Net::Domain::TLD: 1.62
Test::More: 0
no_index:
directory:
- t
- inc
generated_by: ExtUtils::MakeMaker version 6.46
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
Data-Validate-Domain-0.10/Makefile.PL 0000644 0000000 0000000 00000001251 12271076321 0017207 0 ustar 00root root 0000000 0000000 use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
NAME => 'Data::Validate::Domain',
VERSION_FROM => 'lib/Data/Validate/Domain.pm', # finds $VERSION
LICENSE => 'perl',
PREREQ_PM => {
Test::More => 0,
Net::Domain::TLD => 1.62,
}, # e.g., Module::Name => 1.1
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(ABSTRACT_FROM => 'lib/Data/Validate/Domain.pm', # retrieve abstract from module
AUTHOR => 'Neil Neely <neil@neely.cx>') : ()),
);
Data-Validate-Domain-0.10/README 0000644 0000000 0000000 00000021502 12271076321 0016116 0 ustar 00root root 0000000 0000000 NAME
Data::Validate::Domain - domain validation methods
SYNOPSIS
use Data::Validate::Domain qw(is_domain);
# as a function
my $test = is_domain($suspect);
die "$test is not a domain" unless defined $test;
or
my $test = is_domain($suspect,\%options);
die "$test is not a domain" unless defined $test;
# or as an object
my $v = Data::Validate::Domain->new(%options);
my $test = $v->is_domain($suspect);
die "$test is not a domain" unless defined $test;
DESCRIPTION
This module collects domain validation routines to make input
validation, and untainting easier and more readable.
All functions return an untainted value if the test passes, and undef if
it fails. This means that you should always check for a defined status
explicitly. Don't assume the return will be true. (e.g.
is_username('0'))
The value to test is always the first (and often only) argument.
FUNCTIONS
new - constructor for OO usage
$obj = Data::Validate::Domain->new();
my %options = (
domain_allow_single_label => 1,
domain_private_tld => {
'privatetld1 ' => 1,
'privatetld2' => 1,
}
);
or
my %options = (
domain_allow_single_label => 1,
domain_private_tld => qr /^(?:privatetld1|privatetld2)$/,
);
$obj = Data::Validate::Domain->new(%options);
*Description*
Returns a Data::Validator::Domain object. This lets you access
all the validator function calls as methods without importing
them into your namespace or using the clumsy
Data::Validate::Domain::function_name() format.
*Options*
domain_allow_single_label
By default is_domain will fail if you ask it to verify a
domain that only has a single label i.e. 'neely.cx' is good,
but 'com' would fail. If you set this option to a true value
then is_domain will allow single label domains through. This
is most likely to be useful in combination with
domain_private_tld
domain_private_tld
By default is_domain requires all domains to have a valid
TLD (i.e. com, net, org, uk, etc), this is verified using
the Net::Domain::TLD module. This behavior can be extended
in two different ways. Either a hash reference can be
supplied keyed by the additional TLD's, or you can supply a
precompiled regular expression.
NOTE: The TLD is normalized to the lower case form prior to
the check being done. This is done only for the TLD check,
and does not alter the output in any way.
The hash reference example:
domain_private_tld => {
'privatetld1 ' => 1,
'privatetld2' => 1,
}
The precompiled regualar expression example:
domain_private_tld => qr /^(?:privatetld1|privatetld2)$/,
*Returns*
Returns a Data::Validate::Domain object
is_domain - does the value look like a domain name?
is_domain($value);
or
$obj->is_domain($value);
or
is_domain($value,\%options);
or
$obj->is_domain($value,\%options);
*Description*
Returns the untainted domain name if the test value appears to
be a well-formed domain name.
Note: See new for list of options and how those alter the
behavior of this funciton.
*Arguments*
$value
The potential domain to test.
*Returns*
Returns the untainted domain on success, undef on failure.
*Notes, Exceptions, & Bugs*
The function does not make any attempt to check whether a domain
actually exists. It only looks to see that the format is
appropriate.
A dotted quad (such as 127.0.0.1) is not considered a domain and
will return false. See Data::Validate::IP(3) for IP Validation.
Performs a lookup via Net::Domain::TLD to verify that the TLD is
valid for this domain.
Does not consider "domain.com." a valid format.
*From RFC 952*
A "name" (Net, Host, Gateway, or Domain name) is a text string up
to 24 characters drawn from the alphabet (A-Z), digits (0-9), minus
sign (-), and period (.). Note that periods are only allowed when
they serve to delimit components of "domain style names".
No blank or space characters are permitted as part of a
name. No distinction is made between upper and lower case. The first
character must be an alpha character [Relaxed in RFC 1123] . The last
character must not be a minus sign or period.
*From RFC 1035*
labels 63 octets or less
names 255 octets or less
[snip] limit the label to 63 octets or less.
To simplify implementations, the total length of a domain name (i.e.,
label octets and label length octets) is restricted to 255 octets or
less.
*From RFC 1123*
One aspect of host name syntax is hereby changed: the
restriction on the first character is relaxed to allow either a
letter or a digit. Host software MUST support this more liberal
syntax.
Host software MUST handle host names of up to 63 characters and
SHOULD handle host names of up to 255 characters.
is_hostname - does the value look like a hostname
is_hostname($value);
or
$obj->is_hostname($value);
or
is_hostname($value,\%options);
or
$obj->is_hostname($value,\%options);
*Description*
Returns the untainted hostname if the test value appears to be a
well-formed hostname.
Note: See new for list of options and how those alter the
behavior of this funciton.
*Arguments*
$value
The potential hostname to test.
*Returns*
Returns the untainted hostname on success, undef on failure.
*Notes, Exceptions, & Bugs*
The function does not make any attempt to check whether a
hostname actually exists. It only looks to see that the format
is appropriate.
Functions much like is_domain, except that it does not verify
whether or not a valid TLD has been supplied and allows for
there to only be a single component of the hostname (i.e www)
Hostnames might or might not have a valid TLD attached.
is_domain_label - does the value look like a domain label?
is_domain_label($value);
or
$obj->is_domain_label($value);
or
is_domain_label($value,\%options);
or
$obj->is_domain_label($value,\%options);
*Description*
Returns the untainted domain label if the test value appears to
be a well-formed domain label.
Note: See new for list of options and how those alter the
behavior of this funciton.
*Arguments*
$value
The potential ip to test.
*Returns*
Returns the untainted domain label on success, undef on failure.
*Notes, Exceptions, & Bugs*
The function does not make any attempt to check whether a domain
label actually exists. It only looks to see that the format is
appropriate.
SEE ALSO
[RFC 1034] [RFC 1035] [RFC 2181] [RFC 1123]
Data::Validate(3)
Data::Validate::IP(3)
AUTHOR
Neil Neely <neil@neely.cx>.
ACKNOWLEDGEMENTS
Thanks to Richard Sonnen <sonnen@richardsonnen.com> for writing the
Data::Validate module.
Thanks to Len Reed <lreed@levanta.com> for helping develop the
options mechanism for Data::Validate modules.
COPYRIGHT AND LICENSE
Copyright (c) 2005-2006 Neil Neely.
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.2
or, at your option, any later version of Perl 5 you may have
available.
Data-Validate-Domain-0.10/lib/ 0000755 0000000 0000000 00000000000 12271076321 0016004 5 ustar 00root root 0000000 0000000 Data-Validate-Domain-0.10/lib/Data/ 0000755 0000000 0000000 00000000000 12271076321 0016655 5 ustar 00root root 0000000 0000000 Data-Validate-Domain-0.10/lib/Data/Validate/ 0000755 0000000 0000000 00000000000 12271076321 0020406 5 ustar 00root root 0000000 0000000 Data-Validate-Domain-0.10/lib/Data/Validate/Domain.pm 0000644 0000000 0000000 00000027076 12271076321 0022167 0 ustar 00root root 0000000 0000000 package Data::Validate::Domain;
use strict;
use warnings;
use Net::Domain::TLD qw(tld_exists);
require Exporter;
our @ISA = qw(Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
# This allows declaration use Data::Validate::Domain ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(
is_domain
is_hostname
is_domain_label
);
our $VERSION = '0.10';
=head1 NAME
Data::Validate::Domain - domain validation methods
=head1 SYNOPSIS
use Data::Validate::Domain qw(is_domain);
# as a function
my $test = is_domain($suspect);
die "$test is not a domain" unless defined $test;
or
my $test = is_domain($suspect,\%options);
die "$test is not a domain" unless defined $test;
# or as an object
my $v = Data::Validate::Domain->new(%options);
my $test = $v->is_domain($suspect);
die "$test is not a domain" unless defined $test;
=head1 DESCRIPTION
This module collects domain validation routines to make input validation,
and untainting easier and more readable.
All functions return an untainted value if the test passes, and undef if
it fails. This means that you should always check for a defined status explicitly.
Don't assume the return will be true. (e.g. is_username('0'))
The value to test is always the first (and often only) argument.
=head1 FUNCTIONS
=over 4
=item B<new> - constructor for OO usage
$obj = Data::Validate::Domain->new();
my %options = (
domain_allow_underscore => 1,
);
or
my %options = (
domain_allow_single_label => 1,
domain_private_tld => {
'privatetld1 ' => 1,
'privatetld2' => 1,
}
);
or
my %options = (
domain_allow_single_label => 1,
domain_private_tld => qr /^(?:privatetld1|privatetld2)$/,
);
$obj = Data::Validate::Domain->new(%options);
=over 4
=item I<Description>
Returns a Data::Validator::Domain object. This lets you access all the validator function
calls as methods without importing them into your namespace or using the clumsy
Data::Validate::Domain::function_name() format.
=item I<Options>
=over 4
=item B<domain_allow_underscore>
According to RFC underscores are forbidden in "hostnames" but not "domainnames".
By default is_domain,is_domain_label, and is_hostname will fail if you include underscores, setting
this to a true value with authorize the use of underscores in all functions.
=item B<domain_allow_single_label>
By default is_domain will fail if you ask it to verify a domain that only has a single label
i.e. 'neely.cx' is good, but 'com' would fail. If you set this option to a true value then
is_domain will allow single label domains through. This is most likely to be useful in
combination with B<domain_private_tld>
=item B<domain_private_tld>
By default is_domain requires all domains to have a valid TLD (i.e. com, net, org, uk, etc),
this is verified using the Net::Domain::TLD module. This behavior can be extended in two
different ways. Either a hash reference can be supplied keyed by the additional TLD's, or you
can supply a precompiled regular expression.
NOTE: The TLD is normalized to the lower case form prior to the check being done. This is
done only for the TLD check, and does not alter the output in any way.
The hash reference example:
domain_private_tld => {
'privatetld1 ' => 1,
'privatetld2' => 1,
}
The precompiled regualar expression example:
domain_private_tld => qr /^(?:privatetld1|privatetld2)$/,
=back
=item I<Returns>
Returns a Data::Validate::Domain object
=back
=cut
sub new{
my $class = shift;
my $self = bless {}, ref($class) || $class;
%{$self} = @_;
return $self;
}
# -------------------------------------------------------------------------------
=pod
=item B<is_domain> - does the value look like a domain name?
is_domain($value);
or
$obj->is_domain($value);
or
is_domain($value,\%options);
or
$obj->is_domain($value,\%options);
=over 4
=item I<Description>
Returns the untainted domain name if the test value appears to be a well-formed
domain name.
Note: See B<new> for list of options and how those alter the behavior of this
funciton.
=item I<Arguments>
=over 4
=item $value
The potential domain to test.
=back
=item I<Returns>
Returns the untainted domain on success, undef on failure.
=item I<Notes, Exceptions, & Bugs>
The function does not make any attempt to check whether a domain
actually exists. It only looks to see that the format is appropriate.
A dotted quad (such as 127.0.0.1) is not considered a domain and will return false.
See L<Data::Validate::IP(3)> for IP Validation.
Performs a lookup via Net::Domain::TLD to verify that the TLD is valid for this domain.
Does not consider "domain.com." a valid format.
=item I<From RFC 952>
A "name" (Net, Host, Gateway, or Domain name) is a text string up
to 24 characters drawn from the alphabet (A-Z), digits (0-9), minus
sign (-), and period (.). Note that periods are only allowed when
they serve to delimit components of "domain style names".
No blank or space characters are permitted as part of a
name. No distinction is made between upper and lower case. The first
character must be an alpha character [Relaxed in RFC 1123] . The last
character must not be a minus sign or period.
=item I<From RFC 1035>
labels 63 octets or less
names 255 octets or less
[snip] limit the label to 63 octets or less.
To simplify implementations, the total length of a domain name (i.e.,
label octets and label length octets) is restricted to 255 octets or
less.
=item I<From RFC 1123>
One aspect of host name syntax is hereby changed: the
restriction on the first character is relaxed to allow either a
letter or a digit. Host software MUST support this more liberal
syntax.
Host software MUST handle host names of up to 63 characters and
SHOULD handle host names of up to 255 characters.
=back
=cut
sub is_domain {
my $self = shift if ref($_[0]);
my $value = shift;
return unless defined($value);
my $opt = (defined $self)?$self:(shift);
my $length = length($value);
return unless ($length > 0 && $length <= 255);
my @bits;
foreach my $label (split('\.', $value, -1)) {
my $bit = is_domain_label($label,$opt);
return unless defined $bit;
push(@bits, $bit);
}
my $tld = $bits[$#bits];
#domain_allow_single_label set to true disables this check
unless (defined $opt && $opt->{domain_allow_single_label}) {
#All domains have more then 1 label (neely.cx good, com not good)
return unless (@bits >= 2);
}
#If the option to enable domain_private_tld is enabled
#and a private domain is specified, then we return if that matches
if (defined $opt && exists $opt->{domain_private_tld} && ref($opt->{domain_private_tld})) {
my $lc_tld = lc($tld);
if (ref($opt->{domain_private_tld}) eq 'HASH') {
if (exists $opt->{domain_private_tld}->{$lc_tld}) {
return join('.', @bits);
}
} else {
if ($tld =~ $opt->{domain_private_tld}) {
return join('.', @bits);
}
}
}
#Verify domain has a valid TLD
return unless tld_exists($tld);
return join('.', @bits);
}
# -------------------------------------------------------------------------------
=pod
=item B<is_hostname> - does the value look like a hostname
is_hostname($value);
or
$obj->is_hostname($value);
or
is_hostname($value,\%options);
or
$obj->is_hostname($value,\%options);
=over 4
=item I<Description>
Returns the untainted hostname if the test value appears to be a well-formed
hostname.
Note: See B<new> for list of options and how those alter the behavior of this
funciton.
=item I<Arguments>
=over 4
=item $value
The potential hostname to test.
=back
=item I<Returns>
Returns the untainted hostname on success, undef on failure.
=item I<Notes, Exceptions, & Bugs>
The function does not make any attempt to check whether a hostname
actually exists. It only looks to see that the format is appropriate.
Functions much like is_domain, except that it does not verify whether or
not a valid TLD has been supplied and allows for there to only
be a single component of the hostname (i.e www)
Hostnames might or might not have a valid TLD attached.
=back
=cut
sub is_hostname {
my $self = shift if ref($_[0]);
my $value = shift;
return unless defined($value);
my $opt = (defined $self)?$self:(shift);
my $length = length($value);
return unless ($length > 0 && $length <= 255);
# return is_domain_label($value) unless $value =~ /\./; #If just a simple hostname
#Anything past here has multiple bits in it
my @bits;
foreach my $label (split('\.', $value, -1)) {
my $bit = is_domain_label($label,$opt);
return unless defined $bit;
push(@bits, $bit);
}
#We do not verify TLD for hostnames, as hostname.subhost is a valid hostname
return join('.', @bits);
}
=pod
=item B<is_domain_label> - does the value look like a domain label?
is_domain_label($value);
or
$obj->is_domain_label($value);
or
is_domain_label($value,\%options);
or
$obj->is_domain_label($value,\%options);
=over 4
=item I<Description>
Returns the untainted domain label if the test value appears to be a well-formed
domain label.
Note: See B<new> for list of options and how those alter the behavior of this
funciton.
=item I<Arguments>
=over 4
=item $value
The potential ip to test.
=back
=item I<Returns>
Returns the untainted domain label on success, undef on failure.
=item I<Notes, Exceptions, & Bugs>
The function does not make any attempt to check whether a domain label
actually exists. It only looks to see that the format is appropriate.
=cut
sub is_domain_label {
my $self = shift if ref($_[0]);
my $value = shift;
return unless defined($value);
#Fix Bug: 41033
return if ($value =~ /\n/);
my $opt = (defined $self)?$self:(shift);
# bail if we are dealing with more then just a hostname
return if ($value =~ /\./);
my $length = length($value);
my $hostname;
if ($length == 1) {
if (defined $opt && $opt->{domain_allow_underscore}) {
($hostname) = $value =~ /^([\dA-Za-z\_])$/;
} else {
($hostname) = $value =~ /^([\dA-Za-z])$/;
}
} elsif ($length > 1 && $length <= 63) {
if (defined $opt && $opt->{domain_allow_underscore}) {
($hostname) = $value =~ /^([\dA-Za-z\_][\dA-Za-z\-\_]*[\dA-Za-z])$/;
} else {
($hostname) = $value =~ /^([\dA-Za-z][\dA-Za-z\-]*[\dA-Za-z])$/;
}
} else {
return;
}
return $hostname;
}
1;
__END__
#
# -------------------------------------------------------------------------------
=pod
=back
=back
=head1 SEE ALSO
B<[RFC 1034] [RFC 1035] [RFC 2181] [RFC 1123]>
=over 4
=item L<Data::Validate(3)>
=item L<Data::Validate::IP(3)>
=back
=head1 AUTHOR
Neil Neely <F<neil@neely.cx>>.
=head1 ACKNOWLEDGEMENTS
Thanks to Richard Sonnen <F<sonnen@richardsonnen.com>> for writing the Data::Validate module.
Thanks to Len Reed <F<lreed@levanta.com>> for helping develop the options mechanism for Data::Validate modules.
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2005-2007 Neil Neely.
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.2 or,
at your option, any later version of Perl 5 you may have available.
=cut
Data-Validate-Domain-0.10/t/ 0000755 0000000 0000000 00000000000 12271076321 0015501 5 ustar 00root root 0000000 0000000 Data-Validate-Domain-0.10/t/Data-Validate-Domain.t 0000644 0000000 0000000 00000015214 12271076321 0021476 0 ustar 00root root 0000000 0000000 # Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl Data-Validate-Domain.t'
#########################
# change 'tests => 1' to 'tests => last_test_to_print';
use Test::More tests => 59;
BEGIN { use_ok('Data::Validate::Domain', qw(is_hostname is_domain is_domain_label) ) };
#########################
# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.
is ('www', is_domain_label('www'), 'is_domain_label www');
is ('w-w', is_domain_label('w-w'), 'is_domain_label w-w');
is ('neely', is_domain_label('neely'), 'is_domain_label neely');
is ('com', is_domain_label('com'), 'is_domain_label com');
is ('COM', is_domain_label('COM'), 'is_domain_label COM');
is ('128', is_domain_label('128'), 'is_domain_label 128');
is (undef, is_domain_label(''), 'is_domain_label ');
is (undef, is_domain_label('-bob'), 'is_domain_label -bob');
#70 character label
isnt ('1234567890123456789012345678901234567890123456789012345678901234567890',
is_domain_label('1234567890123456789012345678901234567890123456789012345678901234567890'),
'is_domain_label 1234567890123456789012345678901234567890123456789012345678901234567890');
is ('www.neely.cx', is_domain('www.neely.cx'), 'is_domain www.neely.cx');
is (undef, is_domain('www.neely.cx.'), 'is_domain www.neely.cx.');
is (undef, is_domain('www.neely.cx...'), 'is_domain www.neely.cx...');
is (undef, is_domain('www.neely.lkj'), 'is_domain www.neely.lkj');
is ('neely.cx', is_domain('neely.cx'), 'is_domain neely.cx');
is ('test-neely.cx', is_domain('test-neely.cx'), 'is_domain test-neely.cx');
is ('aa.com', is_domain('aa.com'), 'is_domain aa.com');
is ('A-A.com', is_domain('A-A.com'), 'is_domain A-A.com');
is ('aa.com', is_hostname('aa.com'), 'is_hostname aa.com');
is ('aa.bb', is_hostname('aa.bb'), 'is_hostname aa.bb');
is ('aa', is_hostname('aa'), 'is_hostname aa');
is (undef, is_domain('216.17.184.1'), 'is_domain 216.17.184.1');
is (undef, is_domain('test_neely.cx'), 'is_domain test_neely.cx');
is (undef, is_domain('.neely.cx'), 'is_domain .neely.cx');
is (undef, is_domain('-www.neely.cx'), 'is_domain -www.neely.cx');
is (undef, is_domain('a'), 'is_domain a');
is (undef, is_domain('.'), 'is_domain .');
is (undef, is_domain('com.'), 'is_domain com.');
is (undef, is_domain('com'), 'is_domain com');
is (undef, is_domain('net'), 'is_domain net');
is (undef, is_domain('uk'), 'is_domain uk');
is ('co.uk', is_domain('co.uk'), 'is_domain co.uk');
#280+ character domain
is (undef,
is_domain('123456789012345678901234567890123456789012345678901234567890.1234567890123456789012345678901234567890.12345678901234567890123456789012345678901234567890.12345678901234567890123456789012345678901234567890.12345678901234567890123456789012345678901234567890.123456789012345678901234567890.com'),
'is_domain 123456789012345678901234567890123456789012345678901234567890.1234567890123456789012345678901234567890.12345678901234567890123456789012345678901234567890.12345678901234567890123456789012345678901234567890.12345678901234567890123456789012345678901234567890.123456789012345678901234567890.com');
#Some additional tests for options
is ('myhost.neely', is_domain('myhost.neely', {domain_private_tld => {'neely' => 1}}), 'is_domain myhost.neely w/domain_private_tld option');
is (undef, is_domain('myhost.neely'), 'is_domain myhost.neely');
is ('com', is_domain('com', {domain_allow_single_label => 1}), 'is_domain com w/domain_allow_single_label option');
is ('neely', is_domain('neely', {domain_allow_single_label => 1, domain_private_tld => {'neely' => 1}}), 'is_domain neely w/domain_private_tld and domain_allow_single_label option');
is (undef, is_domain('neely'), 'is_domain neely');
isnt ('_spf', is_hostname('_spf'), 'is_hostname("_spf"');
is ('_spf', is_hostname('_spf', {domain_allow_underscore => 1}), 'is_hostname("_spf", {domain_allow_underscore = 1}');
is (undef, is_domain("example\n.com"), 'is_domain( "example\n.com")');
is (undef, is_domain_label("example\n"), 'is_domain_label( "example\n")');
#precompiled regex format
is ('myhost.neely', is_domain('myhost.neely', {domain_private_tld => qr/^neely$/}), 'is_domain myhost.neely w/domain_private_tld option - precompiled regex');
is (undef, is_domain('myhost.neely', {domain_private_tld => qr/^intra$/}), 'is_domain myhost.neely w/domain_private_tld option - precompiled regex looking for intra');
my $obj = Data::Validate::Domain->new();
is ('co.uk', $obj->is_domain('co.uk'), '$obj->is_domain co.uk');
my $private_tld_obj = Data::Validate::Domain->new(
domain_private_tld => {
neely => 1,
neely72 => 1,
},
);
is ('myhost.neely', $private_tld_obj->is_domain('myhost.neely'), '$private_tld_obj->is_domain myhost.neely');
is ('myhost.neely72', $private_tld_obj->is_domain('myhost.neely72'), '$private_tld_obj->is_domain myhost.neely72');
is (undef, $private_tld_obj->is_domain('myhost.intra'), '$private_tld_obj->is_domain myhost.intra');
is (undef, $private_tld_obj->is_domain('neely'), '$private_tld_obj->is_domain neely');
my $private_single_label_tld_obj = Data::Validate::Domain->new(
domain_allow_single_label => 1,
domain_private_tld => {
neely => 1,
},
);
is ('neely', $private_single_label_tld_obj->is_domain('neely'), '$private_single_label_tld_obj->is_domain neely');
is ('NEELY', $private_single_label_tld_obj->is_domain('NEELY'), '$private_single_label_tld_obj->is_domain NEELY');
is ('neely.cx', $private_single_label_tld_obj->is_domain('neely.cx'), '$private_single_label_tld_obj->is_domain neely.cx');
#precompiled regex format
my $private_tld_obj2 = Data::Validate::Domain->new(
domain_private_tld => qr/^(?:neely|neely72)$/,
);
is ('myhost.neely', $private_tld_obj2->is_domain('myhost.neely'), '$private_tld_obj2->is_domain myhost.neely');
is ('myhost.neely72', $private_tld_obj2->is_domain('myhost.neely72'), '$private_tld_obj2->is_domain myhost.neely72');
is (undef, $private_tld_obj2->is_domain('myhost.intra'), '$private_tld_obj2->is_domain myhost.intra');
is (undef, $private_tld_obj2->is_domain('neely'), '$private_tld_obj2->is_domain neely');
my $allow_underscore_obj = Data::Validate::Domain->new(
domain_allow_underscore => 1,
);
is ('_spf.neely.cx', $allow_underscore_obj->is_domain('_spf.neely.cx'), '$allow_underscore_obj->is_domain _spf.neely.cx');
is ('_sip._tcp.neely.cx', $allow_underscore_obj->is_domain('_sip._tcp.neely.cx'), '$allow_underscore_obj->is_domain _sip._tcp.neely.cx');
is ('_spf', $allow_underscore_obj->is_hostname('_spf'), '$allow_underscore_obj->is_domain _spf');
Data-Validate-Domain-0.10/t/Pod-Coverage.t 0000644 0000000 0000000 00000000243 12271076321 0020140 0 ustar 00root root 0000000 0000000 use Test::More;
eval "use Test::Pod::Coverage 1.00";
plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@;
all_pod_coverage_ok();
Data-Validate-Domain-0.10/t/Pod.t 0000644 0000000 0000000 00000000201 12271076321 0016401 0 ustar 00root root 0000000 0000000 use Test::More;
eval "use Test::Pod 1.00";
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
all_pod_files_ok();