File Coverage

blib/lib/Data/MuForm/Types.pm
Criterion Covered Total %
statement 21 21 100.0
branch n/a
condition n/a
subroutine 7 7 100.0
pod n/a
total 28 28 100.0


line stmt bran cond sub pod time code
1             package Data::MuForm::Types;
2             # ABSTRACT: Type::Tiny types
3              
4 3     3   119181 use strict;
  3         3  
  3         69  
5 3     3   9 use warnings;
  3         2  
  3         63  
6              
7 3     3   9 use Scalar::Util "looks_like_number";
  3         3  
  3         157  
8 3     3   1376 use Type::Utils;
  3         69054  
  3         19  
9              
10 3     3   4292 use Types::Standard -types;
  3         87969  
  3         30  
11 3     3   7926 use Type::Library -base;
  3         3  
  3         11  
12              
13             our $class_messages = {
14             PositiveNum => "Must be a positive number",
15             PositiveInt => "Must be a positive integer",
16             NegativeNum => "Must be a negative number",
17             NegativeInt => "Must be a negative integer",
18             SingleDigit => "Must be a single digit",
19             SimpleStr => 'Must be a single line of no more than 255 chars',
20             NonEmptySimpleStr => "Must be a non-empty single line of no more than 255 chars",
21             Password => "Must be between 4 and 255 chars",
22             StrongPassword =>"Must be between 8 and 255 chars, and contain a non-alpha char",
23             NonEmptyStr => "Must not be empty",
24             State => "Not a valid state",
25             Email => "Email is not valid",
26             Zip => "Zip is not valid",
27             IPAddress => "Not a valid IP address",
28             NoSpaces =>'Must not contain spaces',
29             WordChars => 'Must be made up of letters, digits, and underscores',
30             NotAllDigits => 'Must not be all digits',
31             Printable => 'Field contains non-printable characters',
32             PrintableAndNewline => 'Field contains non-printable characters',
33             SingleWord => 'Field must contain a single word',
34             };
35              
36              
37             declare 'PositiveNum', as Num, where { $_ >= 0 }, message { "Must be a positive number" };
38              
39             declare 'PositiveInt', as Int, where { $_ >= 0 }, message { "Must be a positive integer" };
40              
41             declare 'NegativeNum', as Num, where { $_ <= 0 }, message { "Must be a negative number" };
42              
43             declare 'NegativeInt', as Int, where { $_ <= 0 }, message { "Must be a negative integer" };
44              
45             declare 'SingleDigit', as 'PositiveInt', where { $_ <= 9 }, message { "Must be a single digit" };
46              
47             declare 'SimpleStr',
48             as Str,
49             where { ( length($_) <= 255 ) && ( $_ !~ m/\n/ ) },
50             message { $class_messages->{SimpleStr} };
51              
52             declare 'NonEmptySimpleStr',
53             as 'SimpleStr',
54             where { length($_) > 0 },
55             message { $class_messages->{NonEmptySimpleStr} };
56              
57             declare 'Password',
58             as 'NonEmptySimpleStr',
59             where { length($_) >= 4 && length($_) <= 255 },
60             message { $class_messages->{Password} };
61              
62             declare 'StrongPassword',
63             as 'Password',
64             where { ( length($_) >= 8 ) && length($_) <= 255 && (m/[^a-zA-Z]/) },
65             message { $class_messages->{StrongPassword} };
66              
67             declare 'NonEmptyStr', as Str, where { length($_) > 0 }, message { $class_messages->{NonEmptyStr} };
68              
69             declare 'State', as Str, where {
70             my $value = $_;
71             my $state = <<EOF;
72             AL AK AZ AR CA CO CT DE FL GA HI ID IL IN IA KS KY LA ME MD
73             MA MI MN MS MO MT NE NV NH NJ NM NY NC ND OH OK OR PA PR RI
74             SC SD TN TX UT VT VA WA WV WI WY DC AP FP FPO APO GU VI
75             EOF
76             return ( $state =~ /\b($value)\b/i );
77             }, message { $class_messages->{State} };
78              
79             declare 'Email', as Str, where {
80             my $value = shift;
81             require Email::Valid;
82             my $valid;
83             return ( $valid = Email::Valid->address($value) ) &&
84             ( $valid eq $value );
85             }, message { $class_messages->{Email} };
86              
87             declare 'Zip',
88             as Str,
89             where { /^(\s*\d{5}(?:[-]\d{4})?\s*)$/ },
90             message { $class_messages->{Zip} };
91              
92             declare 'IPAddress', as Str, where {
93             /^(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)$/
94             }, message { $class_messages->{IPAddress} };
95              
96             declare 'NoSpaces',
97             as Str,
98             where { ! /\s/ },
99             message { $class_messages->{NoSpaces} };
100              
101             declare 'WordChars',
102             as Str,
103             where { ! /\W/ },
104             message { $class_messages->{WordChars} };
105              
106             declare 'NotAllDigits',
107             as Str,
108             where { ! /^\d+$/ },
109             message { $class_messages->{NotAllDigits} };
110              
111             declare 'Printable',
112             as Str,
113 3     3   4440 where { /^\p{IsPrint}*\z/ },
  3         25  
  3         36  
114             message { $class_messages->{Printable} };
115              
116             declare 'PrintableAndNewline',
117             as Str,
118             where { /^[\p{IsPrint}\n]*\z/ },
119             message { $class_messages->{PrintableAndNewline} };
120              
121             declare 'SingleWord',
122             as Str,
123             where { /^\w*\z/ },
124             message { $class_messages->{SingleWord} };
125              
126             declare 'Collapse',
127             as Str,
128             where{ ! /\s{2,}/ };
129              
130             coerce 'Collapse',
131             from Str,
132             via { s/\s+/ /g; return $_; };
133              
134             declare 'Lower',
135             as Str,
136             where { ! /[[:upper:]]/ };
137              
138             coerce 'Lower',
139             from Str,
140             via { lc };
141              
142             declare 'Upper',
143             as Str,
144             where { ! /[[:lower:]]/ };
145              
146             coerce 'Upper',
147             from Str,
148             via { uc };
149              
150             declare 'Trim',
151             as Str,
152             where { ! /^\s+/ &&
153             ! /\s+$/ };
154              
155             coerce 'Trim',
156             from Str,
157             via { s/^\s+// &&
158             s/\s+$//;
159             return $_; };
160             1;
161              
162             __END__
163              
164             =pod
165              
166             =encoding UTF-8
167              
168             =head1 NAME
169              
170             Data::MuForm::Types - Type::Tiny types
171              
172             =head1 VERSION
173              
174             version 0.04
175              
176             =head1 SYNOPSIS
177              
178             These types are provided by Type::Tiny. These types must not be quoted
179             when they are used:
180              
181             has 'posint' => ( is => 'rw', isa => PositiveInt);
182             has_field 'email' => ( apply => [ Email ] );
183              
184             To import these types into your forms, you must either specify (':all')
185             or list the types you want to use:
186              
187             use Data::MuForm::Types (':all');
188              
189             or:
190              
191             use Data::MuForm::Types ('Email', 'PositiveInt');
192              
193             =head1 DESCRIPTION
194              
195             =head1 Type Constraints
196              
197             These types check the value and issue an error message.
198              
199             =over
200              
201             =item Email
202              
203             Uses Email::Valid
204              
205             =item State
206              
207             Checks that the state is in a list of two uppercase letters.
208              
209             =item Zip
210              
211             =item IPAddress
212              
213             Must be a valid IPv4 address.
214              
215             =item NoSpaces
216              
217             No spaces in string allowed.
218              
219             =item WordChars
220              
221             Must be made up of letters, digits, and underscores.
222              
223             =item NotAllDigits
224              
225             Might be useful for passwords.
226              
227             =item Printable
228              
229             Must not contain non-printable characters.
230              
231             =item SingleWord
232              
233             Contains a single word.
234              
235             =back
236              
237             =head2 Type Coercions
238              
239             These types will transform the value without an error message;
240              
241             =over
242              
243             =item Collapse
244              
245             Replaces multiple spaces with a single space
246              
247             =item Upper
248              
249             Makes the string all upper case
250              
251             =item Lower
252              
253             Makes the string all lower case
254              
255             =item Trim
256              
257             Trims the string of starting and ending spaces
258              
259             =back
260              
261             =head1 AUTHOR
262              
263             Gerda Shank
264              
265             =head1 COPYRIGHT AND LICENSE
266              
267             This software is copyright (c) 2017 by Gerda Shank.
268              
269             This is free software; you can redistribute it and/or modify it under
270             the same terms as the Perl 5 programming language system itself.
271              
272             =cut