File Coverage

blib/lib/MojoX/Validate/Util.pm
Criterion Covered Total %
statement 63 68 92.6
branch 10 14 71.4
condition 8 14 57.1
subroutine 20 22 90.9
pod 11 12 91.6
total 112 130 86.1


line stmt bran cond sub pod time code
1             package MojoX::Validate::Util;
2              
3 5     5   182526 use strict;
  5         12  
  5         125  
4 5     5   22 use warnings;
  5         9  
  5         121  
5 5     5   21 use warnings qw(FATAL utf8); # Fatalize encoding glitches.
  5         10  
  5         152  
6              
7 5     5   1233 use Mojolicious::Validator;
  5         502369  
  5         43  
8              
9 5     5   1552 use Moo;
  5         36038  
  5         23  
10              
11 5     5   6250 use Params::Classify 'is_number';
  5         9913  
  5         337  
12              
13 5     5   1591 use Types::Standard qw/Object/;
  5         272889  
  5         44  
14              
15 5     5   4859 use URI::Find::Schemeless;
  5         72161  
  5         3998  
16              
17             has url_finder =>
18             (
19             default => sub{return URI::Find::Schemeless -> new(sub{my($url, $text) = @_; return $url})},
20             is => 'ro',
21             isa => Object,
22             required => 0,
23             );
24              
25             has validation =>
26             (
27             is => 'rw',
28             isa => Object,
29             required => 0,
30             );
31              
32             has validator =>
33             (
34             default => sub{return Mojolicious::Validator -> new},
35             is => 'ro',
36             isa => Object,
37             required => 0,
38             );
39              
40             our $VERSION = '1.00';
41              
42             # -----------------------------------------------
43              
44             sub BUILD
45             {
46 34     34 0 1105 my($self) = @_;
47              
48 34         123 $self -> validation($self -> validator -> validation);
49 34         1327 $self -> add_dimension_check;
50 34         576 $self -> add_url_check;
51              
52             } # End of BUILD.
53              
54             # -----------------------------------------------
55              
56             sub add_dimension_check
57             {
58 34     34 1 61 my($self) = @_;
59              
60             $self -> validator -> add_check
61             (
62             dimension => sub
63             {
64 7     7   638 my($validation, $topic, $value, @args) = @_;
65              
66             # Return 0 for success, 1 for error!
67             # Warning: The test will fail if (length($value) == 0)!
68              
69 7         19 my($args) = join('|', @args);
70              
71             # We permit exactly 1 copy of one of the args.
72             # This means you cannot omit the arg and default to something.
73              
74 7 100       92 return 1 if ($value !~ /^([0-9.]+)(\s*-\s*[0-9.]+)?\s*(?:$args){1,1}$/);
75              
76 5   100     27 my($one, $two) = ($1, $2 || '');
77 5 100       22 $two = substr($two, 1) if (substr($two, 0, 1) eq '-');
78              
79 5 100       12 if (length($two) == 0)
80             {
81 3         11 return ! is_number($one);
82             }
83             else
84             {
85 2   33     7 return ! (is_number($one) && is_number($two) );
86             }
87             }
88 34         186 );
89              
90             } # End of add_dimension_check.
91              
92             # -----------------------------------------------
93              
94             sub add_url_check
95             {
96 34     34 1 54 my($self) = @_;
97              
98             $self -> validator -> add_check
99             (
100             url => sub
101             {
102 4     4   325 my($validation, $topic, $value, @args) = @_;
103 4         18 my($count) = $self -> url_finder -> find(\$value);
104              
105             # Return 0 for success, 1 for error!
106              
107 4 100       3154 return ($count == 1) ? 0 : 1;
108             }
109 34         159 );
110              
111             } # End of add_url_check.
112              
113             # -----------------------------------------------
114             # Warning: Returns 1 for valid!
115              
116             sub check_ascii_digits
117             {
118 0     0 1 0 my($self, $params, $topic) = @_;
119 0         0 my($value) = $$params{$topic};
120              
121 0 0 0     0 return ( (length($value) == 0) || ($value !~ /^[0-9]+$/) ) ? 0 : 1;
122              
123             } # End of check_ascii_digits.
124              
125             # -----------------------------------------------
126              
127             sub check_dimension
128             {
129 8     8 1 142 my($self, $params, $topic, $units) = @_;
130              
131 8         138 $self -> validation -> input($params);
132              
133 8   100     179 return (length($$params{$topic}) == 0)
134             || $self
135             -> validation
136             -> required($topic)
137             -> dimension(@$units)
138             -> is_valid;
139              
140             } # End of check_dimension.
141              
142             # -----------------------------------------------
143              
144             sub check_equal_to
145             {
146 4     4 1 62 my($self, $params, $topic, $expected) = @_;
147              
148 4         61 $self -> validation -> input($params);
149              
150 4         84 return $self
151             -> validation
152             -> required($topic)
153             -> equal_to($expected)
154             -> is_valid;
155              
156             } # End of check_equal_to.
157              
158             # -----------------------------------------------
159             # Warning: Returns 1 for valid!
160              
161             sub check_key_exists
162             {
163 6     6 1 89 my($self, $params, $topic) = @_;
164              
165 6 100       14 return exists($$params{$topic}) ? 1 : 0;
166              
167             } # End of check_key_exists.
168              
169             # -----------------------------------------------
170              
171             sub check_member
172             {
173 2     2 1 36 my($self, $params, $topic, $set) = @_;
174              
175 2         31 $self -> validation -> input($params);
176              
177 2         45 return $self
178             -> validation
179             -> required($topic)
180             -> in(@$set)
181             -> is_valid;
182              
183             } # End of check_member.
184              
185             # -----------------------------------------------
186             # Warning: Returns 1 for valid!
187              
188             sub check_number
189             {
190 0     0 1 0 my($self, $params, $topic, $expected) = @_;
191              
192 0 0       0 return $$params{$topic} == $expected ? 1 : 0;
193              
194             } # End of check_number.
195              
196             # -----------------------------------------------
197              
198             sub check_optional
199             {
200 2     2 1 37 my($self, $params, $topic) = @_;
201              
202 2         31 $self -> validation -> input($params);
203              
204 2         40 return $self
205             -> validation
206             -> optional($topic)
207             -> is_valid;
208              
209             } # End of check_optional.
210              
211             # -----------------------------------------------
212              
213             sub check_required
214             {
215 8     8 1 132 my($self, $params, $topic) = @_;
216              
217 8         124 $self -> validation -> input($params);
218              
219 8         164 return $self
220             -> validation
221             -> required($topic)
222             -> is_valid;
223              
224             } # End of check_required.
225              
226             # -----------------------------------------------
227              
228             sub check_url
229             {
230 4     4 1 74 my($self, $params, $topic) = @_;
231              
232 4         91 $self -> validation -> input($params);
233              
234 4   66     93 return (length($$params{$topic}) == 0)
235             || $self
236             -> validation
237             -> required($topic)
238             -> url
239             -> is_valid;
240              
241             } # End of check_url.
242              
243             # -----------------------------------------------
244              
245             1;
246              
247             =pod
248              
249             =head1 NAME
250              
251             C - A very convenient wrapper around Mojolicious::Validator
252              
253             =head1 Synopsis
254              
255             This program ships as scripts/synopsis.pl.
256              
257             #!/usr/bin/env perl
258             #
259             # This is a copy of t/01.range.t, without the Test::More parts.
260              
261             use strict;
262             use warnings;
263              
264             use MojoX::Validate::Util;
265              
266             # ------------------------------------------------
267              
268             my(%count) = (fail => 0, pass => 0, total => 0);
269             my($checker) = MojoX::Validate::Util -> new;
270              
271             $checker -> add_dimension_check;
272              
273             my(@data) =
274             (
275             {height => ''}, # Pass.
276             {height => '1'}, # Fail. No unit.
277             {height => '1cm'}, # Pass.
278             {height => '1 cm'}, # Pass.
279             {height => '1m'}, # Pass.
280             {height => '40-70.5cm'}, # Pass.
281             {height => '1.5 -2m'}, # Pass.
282             {height => 'z1'}, # Fail. Not numeric.
283             );
284              
285             my($expected);
286             my($params);
287              
288             for my $i (0 .. $#data)
289             {
290             $count{total}++;
291              
292             $params = $data[$i];
293             $expected = ( ($i == 1) || ($i == $#data) ) ? 0 : 1;
294              
295             $count{fail}++ if ($expected == 0);
296              
297             $count{pass}++ if ($checker -> check_dimension($params, 'height', ['cm', 'm']) == 1);
298             }
299              
300             print "Test counts: \n", join("\n", map{"$_: $count{$_}"} sort keys %count), "\n";
301              
302             This is the printout of synopsis.pl:
303              
304             Test counts:
305             fail: 2
306             pass: 6
307             total: 8
308              
309             See also scripts/demo.pl and t/*.t.
310              
311             =head1 Description
312              
313             C is a wrapper around L which
314             provides a suite of convenience methods for validation.
315              
316             =head1 Distributions
317              
318             This module is available as a Unix-style distro (*.tgz).
319              
320             See L
321             for help on unpacking and installing distros.
322              
323             =head1 Installation
324              
325             Install C as you would any C module:
326              
327             Run:
328              
329             cpanm MojoX::Validate::Util
330              
331             or run:
332              
333             sudo cpan Text::Balanced::Marpa
334              
335             or unpack the distro, and then run:
336              
337             perl Makefile.PL
338             make (or dmake or nmake)
339             make test
340             make install
341              
342             =head1 Constructor and Initialization
343              
344             C is called as C<< my($parser) = MojoX::Validate::Util -> new >>.
345              
346             It returns a new object of type C.
347              
348             C does not take any parameters.
349              
350             =head1 Methods
351              
352             =head2 add_dimension_check()
353              
354             Called in BEGIN(). The check itself is called C, and it is used by calling
355             L.
356              
357             =head2 add_url_check()
358              
359             Called in BEGIN(). The check itself is called C, and it is used by calling
360             L.
361              
362             This method uses L.
363              
364             =head2 check_ascii_digits($params, $topic)
365              
366             This test uses 2 steps:
367              
368             =over 4
369              
370             =item o The length of $$params{$topic} must be > 0, and
371              
372             =item o All digits in $$params{$topic} must be in the set [0-9]
373              
374             =back
375              
376             Parameters:
377              
378             =over 4
379              
380             =item o $params => A hashref
381              
382             E.g.: $params = {age => $value, ...}.
383              
384             =item o $topic => The name of the parameter being tested
385              
386             E.g.: $topic = 'age'.
387              
388             =back
389              
390             Return value: Integer (0 or 1):
391              
392             =over 4
393              
394             =item o 0 => Invalid
395              
396             =item o 1 => Valid
397              
398             =back
399              
400             See also L and
401             L.
402              
403             Note: This method uses neither L nor L.
404              
405             =head2 check_dimension($params, $topic, $units)
406              
407             Parameters:
408              
409             =over 4
410              
411             =item o $params => A hashref
412              
413             E.g.: $params = {height => $value, ...}.
414              
415             =item o $topic => The name of the parameter being tested
416              
417             E.g.: $topic = 'height'.
418              
419             =item o $value => A string containing a floating point number followed by one of the abbreviations
420              
421             Or, the string can contain 2 floating point numbers separated by a hyphen, followed by one of the
422             abbreviations.
423              
424             Spaces can be used liberally within the string, but of course not within the numbers.
425              
426             So the code tests $$params{$topic} = $value.
427              
428             =item o $units => An arrayref of strings of unit names or abbreviations
429              
430             E.g.: $units = ['cm', 'm'].
431              
432             =back
433              
434             Return value: Integer (0 or 1) as returned by L:
435              
436             =over 4
437              
438             =item o 0 => Invalid
439              
440             =item o 1 => Valid
441              
442             =back
443              
444             For some non-undef $topic, $value and $units, here are some sample values for the hashref
445             and the corresponding return values (using $units = ['cm', 'm']):
446              
447             =over 4
448              
449             =item o {height => ''}: returns 1 (sic)
450              
451             =item o {height => '1'}: returns 0
452              
453             =item o {height => '1cm'}: returns 1
454              
455             =item o {height => '1 cm'}: returns 1
456              
457             =item o {height => '1m'}: returns 1
458              
459             =item o {height => '40-70.5cm'}: returns 1
460              
461             =item o {height => '1.5 -2 m'}: returns 1
462              
463             =back
464              
465             =head2 check_equal_to($params, $topic, $other_topic)
466              
467             This test uses B. For a test using B<==>, see L.
468              
469             Parameters:
470              
471             =over 4
472              
473             =item o $params => A hashref
474              
475             E.g.: $params = {password => $value_1, confirm_password => $value_2, ...}.
476              
477             =item o $topic => The name of the parameter being tested
478              
479             E.g.: $topic = 'password'.
480              
481             =item o $other_topic => The name of the other key within $params whose value should match $value_1
482              
483             E.g.: $other_topic = 'confirm_password'.
484              
485             So the code tests (using B) $$params{$topic} = $value_1 with $$params{$other_topic} = $value_2.
486              
487             =back
488              
489             Return value: Integer (0 or 1) as returned by L.
490              
491             =over 4
492              
493             =item o 0 => Invalid
494              
495             =item o 1 => Valid
496              
497             =back
498              
499             See also L and L.
500              
501             =head2 check_key_exists($params, $topic)
502              
503             Parameters:
504              
505             =over 4
506              
507             =item o $params => A hashref
508              
509             E.g.: $params = {email_address => $value, ...}.
510              
511             =item o $topic => The name of the parameter being tested
512              
513             E.g.: $topic = 'email_address'.
514              
515             =back
516              
517             Return value: Integer (0 or 1):
518              
519             =over 4
520              
521             =item o 0 => Invalid
522              
523             =item o 1 => Valid
524              
525             =back
526              
527             For some non-undef $topic, here are some sample values for $params and the corresponding
528             return values (using $topic = 'x'):
529              
530             =over 4
531              
532             =item o {}: returns 0
533              
534             =item o {x => undef}: returns 1
535              
536             =item o {x => ''}: returns 1
537              
538             =item o {x => '0'}: returns 1
539              
540             =item o {x => 0}: returns 1
541              
542             =item o {x => 'yz'}: returns 1
543              
544             =back
545              
546             This method uses neither L nor L.
547              
548             =head2 check_member($params, $topic, $set)
549              
550             Parameters:
551              
552             =over 4
553              
554             =item o $params => A hashref
555              
556             E.g.: $params = {love_popup_ads => $value, ...}.
557              
558             =item o $topic => The name of the parameter being tested
559              
560             E.g.: $topic = 'love_popup_ads'.
561              
562             =item o $set => An arrayref of strings
563              
564             E.g.: ['Yes', B<'No'>].
565              
566             =back
567              
568             Return value: Integer (0 or 1) as returned by L.
569              
570             =over 4
571              
572             =item o 0 => Invalid
573              
574             =item o 1 => Valid
575              
576             =back
577              
578             =head2 check_number($params, $topic, $expected)
579              
580             This test uses B<==>. For a test using B, see L.
581              
582             Parameters:
583              
584             =over 4
585              
586             =item o $params => A hashref
587              
588             E.g.: $params = {age => $value, ...}.
589              
590             =item o $topic => The name of the parameter being tested
591              
592             E.g.: $topic = 'age'.
593              
594             =item o $expected => An integer
595              
596             E.g.: 99.
597              
598             =back
599              
600             Return value: Integer (0 or 1):
601              
602             =over 4
603              
604             =item o 0 => Invalid
605              
606             =item o 1 => Valid
607              
608             =back
609              
610             For some non-undef $topic, $value and $expected, here are some sample values for $value and
611             $expected, and the corresponding return values:
612              
613             =over 4
614              
615             =item o $value == 99 and $expected != 99: returns 0
616              
617             =item o $value == 99 and $expected == 99: returns 1
618              
619             =back
620              
621             See also L and
622             L.
623              
624             Note: This method uses neither L nor L.
625              
626             =head2 check_optional($params, $topic)
627              
628             Parameters:
629              
630             =over 4
631              
632             =item o $params => A hashref
633              
634             E.g.: $params = {email_address => $value, ...}.
635              
636             =item o $topic => The name of the parameter being tested
637              
638             E.g.: $topic = 'email_address'.
639              
640             =back
641              
642             Return value: Integer (0 or 1) as returned by L:
643              
644             =over 4
645              
646             =item o 0 => Invalid
647              
648             =item o 1 => Valid
649              
650             =back
651              
652             For some non-undef $topic, here are some sample values for $params and the corresponding
653             return values (using $topic = 'x'):
654              
655             =over 4
656              
657             =item o {}: returns 0
658              
659             =item o {x => undef}: returns 0
660              
661             =item o {x => ''}: returns 0 (because the length is 0)
662              
663             =item o {x => '0'}: returns 1
664              
665             =item o {x => 0}: returns 1
666              
667             =item o {x => 'yz'}: returns 1
668              
669             =back
670              
671             See also L.
672              
673             See scripts/demo.pl and t/03.email.address.t.
674              
675             =head2 check_required($params, $topic)
676              
677             Parameters:
678              
679             =over 4
680              
681             =item o $params => A hashref
682              
683             E.g.: $params = {email_address => $value, ...}.
684              
685             =item o $topic => The name of the parameter being tested
686              
687             E.g.: $topic = 'email_address'.
688              
689             =back
690              
691             Return value: Integer (0 or 1) as returned by L:
692              
693             =over 4
694              
695             =item o 0 => Invalid
696              
697             =item o 1 => Valid
698              
699             =back
700              
701             For some non-undef $topic, here are some sample values for $params and the corresponding
702             return values (using $topic = 'x'):
703              
704             =over 4
705              
706             =item o {}: returns 0
707              
708             =item o {x => undef}: returns 0
709              
710             =item o {x => ''}: returns 0 (because the length is 0)
711              
712             =item o {x => '0'}: returns 1
713              
714             =item o {x => 0}: returns 1
715              
716             =item o {x => 'yz'}: returns 1
717              
718             =back
719              
720             See also L.
721              
722             See scripts/demo.pl and t/03.email.address.t.
723              
724             =head2 check_url($params, $topic)
725              
726             Parameters:
727              
728             =over 4
729              
730             =item o $params => A hashref
731              
732             E.g.: $params = {homepage => $value, ...}.
733              
734             =item o $topic => The name of the parameter being tested
735              
736             E.g.: $topic = 'homepage'.
737              
738             =back
739              
740             Return value: Integer (0 or 1) as returned by L:
741              
742             =over 4
743              
744             =item o 0 => Invalid
745              
746             =item o 1 => Valid
747              
748             =back
749              
750             For some non-undef $topic, here are some sample values for $params and the corresponding
751             return values (using $topic = 'homepage'):
752              
753             =over 4
754              
755             =item o {homepage => 'localhost'}: returns 0.
756              
757             =item o {homepage => 'savage.net.au'}: returns 1.
758              
759             =item o {homepage => 'http://savage.net.au'}: returns 1.
760              
761             =item o {homepage => 'https://savage.net.au'}: returns 1.
762              
763             =back
764              
765             =head2 new()
766              
767             =head2 url_finder()
768              
769             Returns an object of type L.
770              
771             =head2 validation()
772              
773             Returns an object of type L
774              
775             =head2 validator()
776              
777             Returns an object of type L
778              
779             =head1 FAQ
780              
781             =head2 Why did you prefix all the method names with 'check_'?
782              
783             In order to clarify which methods are part of this module and which are within
784             L or L.
785              
786             =head2 Why provide both check_optional() and check_required()?
787              
788             Calling either C or C within L, and then
789             calling C can return the same value, but the difference becomes apparent after (then)
790             calling methods such as C, C, C and C.
791              
792             This will be much clearer after you study the output of scripts/demo.pl and t/03.email.address.t.
793              
794             =head2 Why did you not make any provision for Mojolicious-style filters?
795              
796             I will add them if there is any interest, but ATM I take the attitude: Release early and release
797             often.
798              
799             =head2 Why did you not use the module C?
800              
801             I was tempted, but it would mean 2 extra, albeit small, complexities:
802              
803             =over 4
804              
805             =item o Another pre-requisite
806              
807             And that conflicts with the minimalistic philosophy of Mojolicious itself.
808              
809             =item o Handling the types of all the values returned from the Mojolicious code
810              
811             =back
812              
813             =head1 See Also
814              
815             L
816              
817             L
818              
819             =head1 Machine-Readable Change Log
820              
821             The file Changes was converted into Changelog.ini by L.
822              
823             =head1 Version Numbers
824              
825             Version numbers < 1.00 represent development versions. From 1.00 up, they are production versions.
826              
827             =head1 Repository
828              
829             L
830              
831             =head1 Support
832              
833             Email the author, or log a bug on RT:
834              
835             L.
836              
837             =head1 Author
838              
839             L was written by Ron Savage Iron@savage.net.auE> in 2017.
840              
841             My homepage: L.
842              
843             =head1 Copyright
844              
845             Australian copyright (c) 2017, Ron Savage.
846              
847             All Programs of mine are 'OSI Certified Open Source Software';
848             you can redistribute them and/or modify them under the terms of
849             The Perl License, a copy of which is available at:
850             http://dev.perl.org/licenses/.
851              
852             =cut