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 4     4   56655 use warnings;
  4         9  
  4         120  
4 4     4   22 use strict;
  4         9  
  4         85  
5              
6 4     4   1266 use Value::Object::ValidationUtils;
  4         9  
  4         172  
7              
8             our $VERSION = '0.14';
9              
10 4     4   3109 use parent 'Value::Object';
  4         1312  
  4         26  
11              
12             sub _why_invalid
13             {
14 15     15   25 my ($self, $value) = @_;
15 15         53 my ($why, $long, $data) = Value::Object::ValidationUtils::why_invalid_domain_name( $value );
16 15 100       49 return ( ref($self) . ": $why", $long, $data ) if defined $why;
17 13         34 return;
18             }
19              
20             sub new_canonical
21             {
22 2     2 1 2077 my ($class, $value) = @_;
23 2         7 $value =~ tr/A-Z/a-z/;
24 2         10 return $class->new( $value );
25             }
26              
27             sub make_subdomain
28             {
29 5     5 1 1261 my ($self, $label) = @_;
30 5 100       24 die ref($self) . ': undefined label' unless defined $label;
31 4 100       5 die ref($self) .': Not a DomainLabel' unless eval { $label->isa( 'Value::Object::DomainLabel' ); };
  4         42  
32 2         6 return __PACKAGE__->new( $label->value . '.' . $self->value );
33             }
34              
35             1;
36             __END__