File Coverage

lib/File/DataClass/Types.pm
Criterion Covered Total %
statement 25 25 100.0
branch n/a
condition n/a
subroutine 9 9 100.0
pod n/a
total 34 34 100.0


line stmt bran cond sub pod time code
1             package File::DataClass::Types;
2              
3 6     6   150469 use strict;
  6         7  
  6         141  
4 6     6   20 use warnings;
  6         7  
  6         120  
5              
6 6     6   1001 use File::DataClass::IO qw( io );
  6         8  
  6         44  
7 6     6   27 use Scalar::Util qw( blessed dualvar );
  6         7  
  6         383  
8 6         67 use Type::Library -base, -declare =>
9             qw( Cache DummyClass HashRefOfBools Lock
10 6     6   27 OctalNum Result Path Directory File );
  6         8  
11 6         35 use Type::Utils qw( as coerce extends from
12 6     6   5260 message subtype via where );
  6         9  
13 6     6   3709 use Unexpected::Functions qw( inflate_message );
  6         7  
  6         52  
14              
15 6     6   1284 use namespace::clean -except => 'meta';
  6         7  
  6         49  
16              
17 6     6   1588 BEGIN { extends q(Unexpected::Types) };
18              
19             # Private functions
20             my $_coercion_for_octalnum = sub {
21             my $x = shift; length $x or return $x;
22              
23             $x =~ m{ [^0-7] }mx and return $x; $x =~ s{ \A 0 }{}gmx;
24              
25             return dualvar oct "${x}", "0${x}"
26             };
27              
28             my $_constraint_for_octalnum = sub {
29             my $x = shift; length $x or return 0;
30              
31             $x =~ m{ [^0-7] }mx and return 0;
32              
33             return ($x < 8) || (oct "${x}" == $x + 0) ? 1 : 0;
34             };
35              
36             my $_exception_message_for_object_reference = sub {
37             return inflate_message( 'String [_1] is not an object reference', $_[ 0 ] );
38             };
39              
40             my $_exception_message_for_cache = sub {
41             blessed $_[ 0 ] and return inflate_message
42             ( 'Object [_1] is not of class File::DataClass::Cache', blessed $_[ 0 ] );
43              
44             return $_exception_message_for_object_reference->( $_[ 0 ] );
45             };
46              
47             my $_exception_message_for_lock = sub {
48             blessed $_[ 0 ] and return inflate_message
49             ( 'Object [_1] is missing set / reset methods', blessed $_[ 0 ] );
50              
51             return $_exception_message_for_object_reference->( $_[ 0 ] );
52             };
53              
54             my $_exception_message_for_path = sub {
55             blessed $_[ 0 ] and return inflate_message
56             ( 'Object [_1] is not of class File::DataClass::IO', blessed $_[ 0 ] );
57              
58             return $_exception_message_for_object_reference->( $_[ 0 ] );
59             };
60              
61             my $_exception_message_for_result = sub {
62             blessed $_[ 0 ] and return inflate_message
63             ( 'Object [_1] is not of class File::DataClass::Result', blessed $_[ 0 ]);
64              
65             return $_exception_message_for_object_reference->( $_[ 0 ] );
66             };
67              
68             subtype Cache, as Object,
69             where { $_->isa( 'File::DataClass::Cache' ) or $_->isa( 'Class::Null' ) },
70             message { $_exception_message_for_cache->( $_ ) };
71              
72             subtype DummyClass, as Str,
73             where { $_ eq 'none' },
74             message { inflate_message( 'Dummy class [_1] is not "none"', $_ ) };
75              
76             subtype HashRefOfBools, as HashRef;
77              
78             subtype Lock, as Object,
79             where { ($_->can( 'set' ) and $_->can( 'reset' ) )
80             or $_->isa( 'Class::Null' ) },
81             message { $_exception_message_for_lock->( $_ ) };
82              
83             subtype OctalNum, as Str,
84             where { $_constraint_for_octalnum->( $_ ) },
85             message { inflate_message( 'String [_1] is not an octal number', $_ ) };
86              
87             subtype Path, as Object,
88             where { $_->isa( 'File::DataClass::IO' ) },
89             message { $_exception_message_for_path->( $_ ) };
90              
91             subtype Result, as Object,
92             where { $_->isa( 'File::DataClass::Result' ) },
93             message { $_exception_message_for_result->( $_ ) };
94              
95              
96             subtype Directory, as Path,
97             where { $_->exists and $_->is_dir },
98             message { inflate_message( 'Path [_1] is not a directory', $_ ) };
99              
100             subtype File, as Path,
101             where { $_->exists and $_->is_file },
102             message { inflate_message( 'Path [_1] is not a file', $_ ) };
103              
104             coerce HashRefOfBools, from ArrayRef,
105             via { my %hash = map { $_ => 1 } @{ $_ }; return \%hash; };
106              
107             coerce OctalNum, from Str, via { $_coercion_for_octalnum->( $_ ) };
108              
109             coerce Directory,
110             from ArrayRef, via { io( $_ ) },
111             from CodeRef, via { io( $_ ) },
112             from HashRef, via { io( $_ ) },
113             from Str, via { io( $_ ) },
114             from Undef, via { io( $_ ) };
115              
116             coerce File,
117             from ArrayRef, via { io( $_ ) },
118             from CodeRef, via { io( $_ ) },
119             from HashRef, via { io( $_ ) },
120             from Str, via { io( $_ ) },
121             from Undef, via { io( $_ ) };
122              
123             coerce Path,
124             from ArrayRef, via { io( $_ ) },
125             from CodeRef, via { io( $_ ) },
126             from HashRef, via { io( $_ ) },
127             from Str, via { io( $_ ) },
128             from Undef, via { io( $_ ) };
129              
130             1;
131              
132             __END__