#!/usr/bin/env perl
use ParseUtil::Domain ':parse';
test 'cannot find tld' => sub {
my ($self) = @_;
my $control = qtakeover 'ParseUtil::Domain::ConfigData';
$control->override(tld_regex => sub { return qr/notlds/; });
throws_ok {
parse_domain('somedomain.com');
} qr/Could\snot\sfind\stld/, 'Croaks when tld not available.';
my $metrics = $control->metrics;
is($metrics->{tld_regex}, 1, 'Called once.');
$control->restore('tld_regex');
$control = undef;
};
test 'can find tld' => sub {
my ($self) = @_;
my $control = qtakeover 'ParseUtil::Domain::ConfigData';
$control->override(tld_regex => sub { return qr/test/; });
lives_ok {
parse_domain('somedomain.test');
} 'Finds tld.';
my $metrics = $control->metrics;
is($metrics->{tld_regex}, 1, 'Called once.');
$control->restore('tld_regex');
$control = undef;
};
test 'undefined mapping croaks' => sub {
my ($self) = @_;
throws_ok {
ParseUtil::Domain::_punycode_segments(['']);
} qr/Error\sprocessing\sdomain/, 'Croaks to death if domain segment empty.';
};
test 'normal mapping does not croak' => sub {
my ($self) = @_;
lives_ok {
ParseUtil::Domain::_punycode_segments(['somedomain']);
} 'Does not crash if domain mapping normal.';
};
test 'croak if nameprep different from decoded' => sub {
my ($self) = @_;
my $control = qtakeover 'ParseUtil::Domain';
$control->override(nameprep => sub {die "Error processing domain";});
throws_ok {
ParseUtil::Domain::_punycode_segments(['somedomain']);
} qr/Error\sprocessing\sdomain/, 'Croaks to death if nameprep result not equal.';
$control->restore('nameprep');
$control = undef;
};
run_me;
done_testing;