File Coverage

blib/lib/Data/MuForm/Field/URL.pm
Criterion Covered Total %
statement 12 12 100.0
branch 2 2 100.0
condition n/a
subroutine 4 4 100.0
pod 1 2 50.0
total 19 20 95.0


line stmt bran cond sub pod time code
1             package Data::MuForm::Field::URL;
2             # ABSTRACT: URL field
3 2     2   1141 use Moo;
  2         2  
  2         12  
4             extends 'Data::MuForm::Field::Text';
5 2     2   1339 use Regexp::Common ('URI');
  2         3517  
  2         5  
6              
7              
8             has '+html5_input_type' => ( default => 'url' );
9              
10             our $class_messages = {
11             'invalid_url' => 'Invalid URL',
12             };
13              
14             sub get_class_messages {
15 1     1 0 2 my $self = shift;
16             return {
17 1         2 %{ $self->next::method },
  1         6  
18             %$class_messages,
19             }
20             }
21              
22             sub validate {
23 2     2 1 3 my ($self, $value) = @_;
24 2 100       13 unless ( $value =~ qr/^$RE{URI}{HTTP}{-scheme => "https?"}$/ ) {
25 1         298 $self->add_error($self->get_message('invalid_url'));
26             }
27             }
28              
29             1;
30              
31             __END__
32              
33             =pod
34              
35             =encoding UTF-8
36              
37             =head1 NAME
38              
39             Data::MuForm::Field::URL - URL field
40              
41             =head1 VERSION
42              
43             version 0.04
44              
45             =head1 DESCRIPTION
46              
47             A URL field;
48              
49             =head1 NAME
50              
51             Data::MuForm::Field::URL
52              
53             =head1 AUTHOR
54              
55             Gerda Shank
56              
57             =head1 COPYRIGHT AND LICENSE
58              
59             This software is copyright (c) 2017 by Gerda Shank.
60              
61             This is free software; you can redistribute it and/or modify it under
62             the same terms as the Perl 5 programming language system itself.
63              
64             =cut