File Coverage

blib/lib/Data/FormValidator/Constraints/Words.pm
Criterion Covered Total %
statement 78 78 100.0
branch 33 34 97.0
condition 2 2 100.0
subroutine 29 29 100.0
pod 16 16 100.0
total 158 159 99.3


line stmt bran cond sub pod time code
1             package Data::FormValidator::Constraints::Words;
2              
3 7     7   108312 use strict;
  7         16  
  7         253  
4 7     7   32 use warnings;
  7         9  
  7         269  
5              
6 7         945 use vars qw($VERSION $AUTOLOAD
7             $REALNAME $BASICWORDS $SIMPLEWORDS $PRINTSAFE $PARAGRAPH
8 7     7   32 $USERNAME $PASSWORD);
  7         15  
9              
10             $VERSION = '0.09';
11              
12             #----------------------------------------------------------------------------
13              
14             =head1 NAME
15              
16             Data::FormValidator::Constraints::Words - Data constraints for word inputs.
17              
18             =head1 SYNOPSIS
19              
20             use Data::FormValidator::Constraints::Words;
21              
22             my $rv = Data::FormValidator->check(\%input, {
23             real_name => realname(),
24             basic_words => basicwords(),
25             simple_words => simplewords(),
26             print_safe => printsafe(),
27             paragraph => paragraph(),
28             username => username(),
29             password => password(),
30             },
31              
32             # or, use the regular functions
33             my $rv = Data::FormValidator->check(\%input, {
34             comments => sub {
35             my($dfv, $value) = @_;
36             return $dfv->match_paragraph($value);
37             }
38             });
39              
40             =head1 DESCRIPTION
41              
42             C provides several methods that
43             can be used to generate constraint closures for use with C
44             for the purpose of validating textual input.
45              
46             =cut
47              
48             #----------------------------------------------------------------------------
49             # Exporter Settings
50              
51             require Exporter;
52 7     7   31 use vars qw($VERSION @ISA @EXPORT);
  7         16  
  7         6009  
53             @ISA = qw(Exporter);
54             @EXPORT = qw(
55             realname valid_realname match_realname
56             basicwords valid_basicwords match_basicwords
57             simplewords valid_simplewords match_simplewords
58             printsafe valid_printsafe match_printsafe
59             paragraph valid_paragraph match_paragraph
60             username valid_username match_username
61             password valid_password match_password
62             );
63              
64             #----------------------------------------------------------------------------
65             # Variables
66              
67             =head1 CHARACTER SETS
68              
69             In the methods below several character code ranges are specified, below is
70             a quick guide to what those ranges represent:
71              
72             Dec Oct Hex Description
73             ---------------------------------------------------------
74             32-47 040-057 20-2F ASCII symbols
75             48-57 060-071 30-39 ASCII numerals
76             58-64 072-100 3A-40 ASCII symbols
77             65-90 101-132 41-5A ASCII uppercase alphabetics
78             91-96 133-140 5B-60 ASCII symbols
79             97-122 141-172 61-7A ASCII lowercase alphabetics
80             123-126 173-176 7B-7E ASCII symbols
81             128-159 200-237 80-9F Extended symbols (unsupported in HTML4 standard)
82             160-191 240-277 A0-BF Extended symbols
83             192-255 300-377 C0-FF Extended alphabetics
84              
85             The above table is based on the ISO Latin 1 (ISO 8859-1) set of encodings. The
86             character range of 128-159 has no corresponding HTML entity encodings, and are
87             considered control characters in the ISO Latin 1 character set. See
88             http://www.ascii-code.com/ for more details.
89              
90             If you wish to override these settings, subclass this module and set the
91             appropriate values for the following regular expression settings:
92              
93             $REALNAME = q/\-\s\w.,\'\xC0-\xFF/;
94             $BASICWORDS = q/\-\s\w.,\'\"&;:\?\#\xC0-\xFF/;
95             $SIMPLEWORDS = q/\-\s\w.,\'\"&;:\?\#~\+=\(\)\[\]\{\}<>\/!\xC0-\xFF/;
96             $PRINTSAFE = q/\s\x20-\x7E\xA0-\xFF/;
97             $PARAGRAPH = q/\s\x20-\x7E\xA0-\xFF/;
98             $USERNAME = q/\x30-\x39\x41-\x5A\x61-\x7A\x8A\x8C\x8E\x9A\x9C\x9E\x9F\xC0-\xFF/;
99             $PASSWORD = q/\x21-\x7E\x80\x82-\x8C\x8E\x91-\x9C\x9E-\x9F\xA1-\xAC\xAE-\xFF/;
100              
101             Note that these are used within a character class, so characters such as '-'
102             must be escaped.
103              
104             Although here PRINTSAFE and PARAGRAPH are the same, they may not be when
105             subclassed.
106              
107             Both USERNAME and PASSWORD exclude whitespace characters, while USERNAME also
108             excludes all symbol characters.
109              
110             =cut
111              
112             $REALNAME = q/\-\s\w.,\'\xC0-\xFF/;
113             $BASICWORDS = q/\-\s\w.,\'\"&;:\?\#\xC0-\xFF/;
114             $SIMPLEWORDS = q/\-\s\w.,\'\"&;:\?\#~\+=\(\)\[\]\{\}<>\/!\xC0-\xFF/;
115             $PRINTSAFE = q/\s\x20-\x7E\xA0-\xFF/;
116             $PARAGRAPH = q/\s\x20-\x7E\xA0-\xFF/;
117             $USERNAME = q/\x30-\x39\x41-\x5A\x61-\x7A\x8A\x8C\x8E\x9A\x9C\x9E\x9F\xC0-\xFF/;
118             $PASSWORD = q/\x21-\x7E\x80\x82-\x8C\x8E\x91-\x9C\x9E-\x9F\xA1-\xAC\xAE-\xFF/;
119              
120             #----------------------------------------------------------------------------
121             # Subroutines
122              
123             =head1 METHODS
124              
125             =head2 realname
126              
127             The realname methods allows commonly used characters within a person's name
128             to be used. Also restricts the string length to 128 characters. Acceptable
129             characters must match the $REALNAME regular expression.
130              
131             =over 4
132              
133             =item * realname
134              
135             =item * valid_realname
136              
137             =item * match_realname
138              
139             =back
140              
141             =cut
142              
143             sub realname {
144             return sub {
145 6     6   8357 my ($self,$word) = @_;
146 6         11 $self->set_current_constraint_name('realname');
147 6         22 $self->valid_realname($word);
148             }
149 2     2 1 23 }
150              
151             sub valid_realname {
152 13     13 1 2380 my ($self,$word) = @_;
153 13 100       34 return 0 unless($word);
154 11 100       871 $word =~ m< ^( [$REALNAME]+ )$ >x ? 1 : 0;
155             }
156              
157             sub match_realname {
158 7     7 1 3241 my ($self,$word) = @_;
159 7 100       25 return unless defined $word;
160 6         22 $word =~ s/\s+/ /g;
161 6         78 $word =~ s/[^$REALNAME]+//g;
162 6         25 return substr $word, 0, 128;
163             }
164              
165             =head2 basicwords
166              
167             The basicwords methods allow a restricted character set to match simple
168             strings, such as reference codes. Acceptable characters must match the
169             $BASICWORDS regular expression:
170              
171             =over 4
172              
173             =item * basicwords
174              
175             =item * valid_basicwords
176              
177             =item * match_basicwords
178              
179             =back
180              
181             =cut
182              
183             sub basicwords {
184             return sub {
185 6     6   9091 my ($self,$word) = @_;
186 6         16 $self->set_current_constraint_name('basicwords');
187 6         34 $self->valid_basicwords($word);
188             }
189 2     2 1 9 }
190              
191             sub match_basicwords {
192 20     20 1 3525 my ($self,$word) = @_;
193 20 100       59 return unless defined $word;
194 18 100       3058 $word =~ m< ^( [$BASICWORDS]+ )$ >x ? $1 : undef;
195             }
196              
197             =head2 simplewords
198              
199             The simplewords methods allow commonly used characters within simple text box
200             input, such as for titles. Acceptable characters must match the $SIMPLEWORDS
201             regular expression.
202              
203             =over 4
204              
205             =item * simplewords
206              
207             =item * valid_simplewords
208              
209             =item * match_simplewords
210              
211             =back
212              
213             =cut
214              
215             sub simplewords {
216             return sub {
217 6     6   8504 my ($self,$word) = @_;
218 6         14 $self->set_current_constraint_name('simplewords');
219 6         38 $self->valid_simplewords($word);
220             }
221 2     2 1 7 }
222              
223             sub match_simplewords {
224 20     20 1 3128 my ($self,$word) = @_;
225 20 100       52 return unless defined $word;
226 18 100       1109 $word =~ m< ^( [$SIMPLEWORDS]+ )$ >x ? $1 : undef;
227             }
228              
229             =head2 printsafe
230              
231             The printsafe methods restrict characters to those non-control characters
232             within the character set. Acceptable characters must match the $PRINTSAFE
233             regular expression.
234              
235             =over 4
236              
237             =item * printsafe
238              
239             =item * valid_printsafe
240              
241             =item * match_printsafe
242              
243             =back
244              
245             =cut
246              
247             sub printsafe {
248             return sub {
249 6     6   8470 my ($self,$word) = @_;
250 6         13 $self->set_current_constraint_name('printsafe');
251 6         23 $self->valid_printsafe($word);
252             }
253 2     2 1 9 }
254              
255             sub valid_printsafe {
256 13     13 1 3028 my ($self,$word) = @_;
257 13 100       41 return unless defined $word;
258 12 100       357 $word =~ m< ^( [$PRINTSAFE]+ )$ >x ? 1 : 0;
259             }
260              
261             sub match_printsafe {
262 7     7 1 3222 my ($self,$word) = @_;
263 7 100       27 return unless defined $word;
264 6         53 $word =~ s/[^$PRINTSAFE]+//;
265 6   100     29 return $word || undef;
266             }
267              
268             =head2 paragraph
269              
270             The paragraph methods allows for a larger range of characters that would be
271             expected to appear in a textarea input, such as a news story or a review.
272             Acceptable characters must match the $PARAGRAPH regular expression:
273              
274             =over 4
275              
276             =item * paragraph
277              
278             =item * valid_paragraph
279              
280             =item * match_paragraph
281              
282             =back
283              
284             =cut
285              
286             sub paragraph {
287             return sub {
288 6     6   8790 my ($self,$word) = @_;
289 6         15 $self->set_current_constraint_name('paragraph');
290 6         55 $self->valid_paragraph($word);
291             }
292 2     2 1 8 }
293              
294             sub match_paragraph {
295 20     20 1 3365 my ($self,$word) = @_;
296 20 100       55 return unless defined $word;
297 18 100       510 $word =~ m< ^( [$PARAGRAPH]+ )$ >x ? $1 : undef;
298             }
299              
300             =head2 username
301              
302             The username methods allows for a restricted range of letter only characters
303             that would be expected to appear in a username style input field. Acceptable
304             characters must match the $USERNAME regular expression:
305              
306             =over 4
307              
308             =item * username
309              
310             =item * valid_username
311              
312             =item * match_username
313              
314             =back
315              
316             =cut
317              
318             sub username {
319             return sub {
320 6     6   7448 my ($self,$word) = @_;
321 6         17 $self->set_current_constraint_name('username');
322 6         32 $self->valid_username($word);
323             }
324 2     2 1 11 }
325              
326             sub match_username {
327 20     20 1 3141 my ($self,$word) = @_;
328 20 100       59 return unless defined $word;
329 18 100       244 $word =~ m< ^( [$USERNAME]+ )$ >x ? $1 : undef;
330             }
331              
332             =head2 password
333              
334             The password methods allows for a restricted range of characters that would be
335             expected to appear in a password style input field. Acceptable characters must
336             match the $PASSWORD regular expression:
337              
338             =over 4
339              
340             =item * password
341              
342             =item * valid_password
343              
344             =item * match_password
345              
346             =back
347              
348             =cut
349              
350             sub password {
351             return sub {
352 6     6   8672 my ($self,$word) = @_;
353 6         11 $self->set_current_constraint_name('password');
354 6         38 $self->valid_password($word);
355             }
356 2     2 1 22 }
357              
358             sub match_password {
359 20     20 1 2911 my ($self,$word) = @_;
360 20 100       53 return unless defined $word;
361 18 100       203 $word =~ m< ^( [$PASSWORD]+ )$ >x ? $1 : undef;
362             }
363              
364             sub AUTOLOAD {
365 65     65   14328 my $name = $AUTOLOAD;
366              
367 7     7   42 no strict qw/refs/;
  7         7  
  7         771  
368              
369 65         380 my ($pkg,$sub) = $name =~ m/^(.*::)valid_(.*)/;
370 65 50       153 return unless($sub);
371              
372             # All non-defined valid_* routines are essentially identical to their
373             # match_* counterpart, we're going to generate them dynamically from
374             # the appropriate match_* routine.
375 65         78 return defined &{$pkg.'match_' . $sub}(@_);
  65         305  
376             }
377              
378             1;
379              
380             __END__