File Coverage

blib/lib/Valiemon/Attributes/Format.pm
Criterion Covered Total %
statement 32 32 100.0
branch 8 8 100.0
condition n/a
subroutine 11 11 100.0
pod 0 2 0.0
total 51 53 96.2


line stmt bran cond sub pod time code
1             package Valiemon::Attributes::Format;
2 3     3   1775 use strict;
  3         6  
  3         91  
3 3     3   11 use warnings;
  3         4  
  3         81  
4 3     3   12 use utf8;
  3         3  
  3         18  
5 3     3   616 use parent qw(Valiemon::Attributes);
  3         360  
  3         15  
6              
7 3     3   168 use Carp qw(croak);
  3         4  
  3         161  
8 3     3   1609 use Data::Validate::URI qw();
  3         108885  
  3         614  
9              
10 40     40 0 76 sub attr_name { 'format' }
11              
12             sub is_valid {
13 41     41 0 49 my ($class, $context, $schema, $data) = @_;
14              
15 41 100       85 return 1 unless $context->prims->is_string($data);
16              
17             $context->in_attr($class, sub {
18 40     40   51 my $format = $schema->{format};
19              
20 40 100       72 if ($format eq 'date-time') {
21 10         13 return _validate_date_time($data);
22             }
23              
24 30 100       45 if ($format eq 'uri') {
25 16         24 return _validate_uri($data);
26             }
27              
28             # TODO: email, hostname, ipv4, ipv6
29              
30 14         1270 croak sprintf 'invalid format: `%s`', $format;
31 40         167 });
32             }
33              
34             sub _validate_date_time {
35 10     10   12 my ($data) = @_;
36             # TODO: check range of value (date-month must be `01-12` etc...)
37 10 100       42 $data =~ /\A\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}(\.\d+)?(Z|[+-]\d{2}:\d{2})/ ? 1 : 0;
38             }
39              
40             sub _validate_uri {
41 16     16   15 my ($data) = @_;
42 16         302 Data::Validate::URI::is_uri($data);
43             }
44              
45             1;