File Coverage

blib/lib/Value/Object/Domain.pm
Criterion Covered Total %
statement 24 24 100.0
branch 6 6 100.0
condition n/a
subroutine 7 7 100.0
pod 2 2 100.0
total 39 39 100.0


line stmt bran cond sub pod time code
1             package Value::Object::Domain;
2              
3 5     5   50958 use warnings;
  5         9  
  5         132  
4 5     5   22 use strict;
  5         8  
  5         100  
5              
6 5     5   1049 use Value::Object::ValidationUtils;
  5         11  
  5         207  
7              
8             our $VERSION = '0.13';
9              
10 5     5   2707 use parent 'Value::Object';
  5         1110  
  5         24  
11              
12             sub _why_invalid
13             {
14 15     15   27 my ($self, $value) = @_;
15 15         45 my ($why, $long, $data) = Value::Object::ValidationUtils::why_invalid_domain_name( $value );
16 15 100       40 return ( ref($self) . ": $why", $long, $data ) if defined $why;
17 13         33 return;
18             }
19              
20             sub new_canonical
21             {
22 2     2 1 669 my ($class, $value) = @_;
23 2         5 $value =~ tr/A-Z/a-z/;
24 2         6 return $class->new( $value );
25             }
26              
27             sub make_subdomain
28             {
29 5     5 1 1605 my ($self, $label) = @_;
30 5 100       28 die ref($self) . ': undefined label' unless defined $label;
31 4 100       7 die ref($self) .': Not a DomainLabel' unless eval { $label->isa( 'Value::Object::DomainLabel' ); };
  4         61  
32 2         9 return __PACKAGE__->new( $label->value . '.' . $self->value );
33             }
34              
35             1;
36             __END__