=head1 EXPORT A list of functions that can be exported. You can delete this section if you don't export anything, such as for a purely object-oriented module. =head1 SUBROUTINES/METHODS =head2 validate =cut #### =head1 SUBROUTINES =head2 validate This function accepts a string or a list (range) and returns an array. In the string form the accepted characters are: positive integers, dots, commas and spaces. Every space will be removed. #### git-client> git status On branch master Changes not staged for commit: (use "git add <file>..." to update what will be committed) (use "git checkout -- <file>..." to discard changes in working directory) modified: lib/Range/Validator.pm no changes added to commit (use "git add" and/or "git commit -a") git-client> git commit -a -m "initial POD to document validate function" [master a6dc557] initial POD to document validate function 1 file changed, 5 insertions(+), 6 deletions(-) #### # not allowed a lone . croak "invalid range [$range] (single .)!" if $range =~ /[^.]+\.{1}[^.]+/; # not allowed more than 2 . croak "invalid range [$range] (more than 2 .)!" if $range =~ /[^.]+\.{3}/; #### sub validate{ my $range; my @range; # assume we have a string if we receive only one argument if ( @_ == 1){ $range = $_[0]; } # otherwise we received a list else{ ... } # remove any space from string $range =~ s/\s+//g; # die if invalid characters croak "invalid character passed in string [$range]!" if $range =~ /[^\s,.\d]/; # not allowed a lone . croak "invalid range [$range] (single .)!" if $range =~ /[^.]+\.{1}[^.]+/; # not allowed more than 2 . croak "invalid range [$range] (more than 2 .)!" if $range =~ /[^.]+\.{3}/; @range = eval ($range); return @range; } #### note ("start checks about incorrect dots in string"); dies_ok { Range::Validator::validate('1.2') } "expected to die with a lone dot"; dies_ok { Range::Validator::validate('0..2,5.6,8') } "expected to die with a lone dot"; #### shell> prove -l -v ./t/01-validate.t ./t/01-validate.t .. ok 1 - use Range::Validator; ok 2 - ok valid string produces correct number of elements # starting test of forbidden characters in the string form ok 3 - expected to die with invalid character # start checks about incorrect dots in string ok 4 - expected to die with a lone dot ok 5 - expected to die with a lone dot 1..5 ok All tests successful. Files=1, Tests=5, 0 wallclock secs ( 0.06 usr + 0.03 sys = 0.09 CPU) Result: PASS #### foreach my $string ( '1.2', '0..2,5.6,8', '1,2,.,3', '.' ){ dies_ok { Range::Validator::validate( $string ) } "expected to die with a lone dot in range [$string]"; } #### shell> prove -l -v ./t/01-validate.t ./t/01-validate.t .. ok 1 - use Range::Validator; ok 2 - ok valid string produces correct number of elements # Failed test 'expected to die with a lone dot in range [.]' # starting test of forbidden characters in the string form # at ./t/01-validate.t line 22. ok 3 - expected to die with invalid character # Looks like you failed 1 test of 7. # start checks about incorrect dots in string ok 4 - expected to die with a lone dot in range [1.2] ok 5 - expected to die with a lone dot in range [0..2,5.6,8] ok 6 - expected to die with a lone dot in range [1,2,.,3] not ok 7 - expected to die with a lone dot in range [.] 1..7 Dubious, test returned 1 (wstat 256, 0x100) Failed 1/7 subtests Test Summary Report ------------------- ./t/01-validate.t (Wstat: 256 Tests: 7 Failed: 1) Failed test: 7 Non-zero exit status: 1 Files=1, Tests=7, 0 wallclock secs ( 0.02 usr + 0.03 sys = 0.05 CPU) Result: FAIL #### # not allowed a lone . croak "invalid range [$range] (single .)!" if $range =~ /(?## foreach my $string ( '1.2', '0..2,5.6,8', '1,2,.,3', '.', '1.', '.1' ){ dies_ok { Range::Validator::validate( $string ) } "expected to die with a lone dot in range [$string]"; } #### foreach my $newstring ( '1...3', '1,3...5','...', '1...', '...2' ){ dies_ok { Range::Validator::validate( $newstring ) } "expected to die with three dots in range [$newstring]"; } #### shell> prove -l -v ./t/01-validate.t ./t/01-validate.t .. ok 1 - use Range::Validator; ok 2 - ok valid string produces correct number of elements # starting test of forbidden characters in the string form ok 3 - expected to die with invalid character # start checks about incorrect dots in string ok 4 - expected to die with a lone dot in range [1.2] ok 5 - expected to die with a lone dot in range [0..2,5.6,8] ok 6 - expected to die with a lone dot in range [1,2,.,3] ok 7 - expected to die with a lone dot in range [.] ok 8 - expected to die with a lone dot in range [1.] ok 9 - expected to die with a lone dot in range [.1] ok 10 - expected to die with three dots in range [1...3] ok 11 - expected to die with three dots in range [1,3...5] ok 12 - expected to die with three dots in range [...] ok 13 - expected to die with three dots in range [1...] ok 14 - expected to die with three dots in range [...2] 1..14 ok All tests successful. Files=1, Tests=14, 1 wallclock secs ( 0.03 usr + 0.03 sys = 0.06 CPU) Result: PASS #### sub validate{ my $range; my @range; # assume we have a string if we receive only one argument if ( @_ == 1){ $range = $_[0]; } # otherwise we received a list else{ ... } # remove any space from string $range =~ s/\s+//g; # die if invalid characters croak "invalid character passed in string [$range]!" if $range =~ /[^\s,.\d]/; # not allowed a lone . croak "invalid range [$range] (single .)!" if $range =~ /(?## #!perl use 5.006; use strict; use warnings; use Test::More qw(no_plan); use Test::Exception; use_ok( 'Range::Validator' ); ok (scalar Range::Validator::validate('0..2') == 3, 'ok valid string produces correct number of elements' ); note ("starting test of forbidden characters in the string form"); dies_ok { Range::Validator::validate('xxxinvalidstringxxx') } "expected to die with invalid character"; note ("start checks about incorrect dots in string"); foreach my $string ( '1.2', '0..2,5.6,8', '1,2,.,3', '.', '1.', '.1' ){ dies_ok { Range::Validator::validate( $string ) } "expected to die with a lone dot in range [$string]"; } foreach my $newstring ( '1...3', '1,3...5','...', '1...', '...2' ){ dies_ok { Range::Validator::validate( $newstring ) } "expected to die with three dots in range [$newstring]"; } #### git-client> git status On branch master Changes not staged for commit: (use "git add <file>..." to update what will be committed) (use "git checkout -- <file>..." to discard changes in working directory) modified: lib/Range/Validator.pm modified: t/01-validate.t no changes added to commit (use "git add" and/or "git commit -a") git-client> git commit -a -m "changed regexes for 2 o lone dot and relative tests" [master 169809c] changed regexes for 2 o lone dot and relative tests 2 files changed, 17 insertions(+), 1 deletion(-) git-client> git push YourGithubLogin master fatal: HttpRequestException encountered. Username for 'https://github.com': YourGithubLogin Password for 'https://YourGithubLogin@github.com': Counting objects: 12, done. Delta compression using up to 4 threads. Compressing objects: 100% (8/8), done. Writing objects: 100% (12/12), 1.50 KiB | 385.00 KiB/s, done. Total 12 (delta 5), reused 0 (delta 0) remote: Resolving deltas: 100% (5/5), completed with 3 local objects. To https://github.com/YourGithubLogin/Range-Validator 5083ec3..169809c master -> master #### # spot reverse ranges like 27..5 if ($range =~ /[^.]\.\.[^.]/){ foreach my $match ( $range=~/(\d+\.\.\d+)/g ){ $match=~/(\d+)\.\.(\d+)/; croak "$1 > $2 in range [$range]" if $1 > $2; } } #### # eval the range @range = eval ($range); # remove duplicate elements using a hash my %single = map{ $_ => 1} @range; # -- new line # sort unique keys numerically @range = sort{ $a <=> $b } keys %single; # -- new line return @range; #### sub validate{ my $range; my @range; # assume we have a string if we receive only one argument if ( @_ == 1){ $range = $_[0]; } # otherwise we received a list else{ ... } # remove any space from string $range =~ s/\s+//g; # die if invalid characters croak "invalid character passed in string [$range]!" if $range =~ /[^\s,.\d]/; # not allowed a lone . croak "invalid range [$range] (single .)!" if $range =~ /(? $2 in range [$range]" if $1 > $2; } } # eval the range @range = eval ($range); # remove duplicate elements using a hash my %single = map{ $_ => 1} @range; # sort unique keys numerically @range = sort{ $a <=> $b } keys %single; return @range; } #### git-client> git log HEAD --oneline bb952ee (HEAD -> master, YourGithubLogin/master) removing duplicates from overlapping ranges 15a5f63 check for reverse ranges in string form 169809c changed regexes for 2 o lone dot and relative tests a6dc557 initial POD to document validate function 5083ec3 added 01-validate.t 580f628 some code into validate, added 01-validate.t and modified Makefile.PL 49a0690 moved POD, removed -T 1788c12 module-starter created content #### foreach my $reversed ('3..1,7..9','1..4,7..5','3..4, 7..5','0..2,27..5'){ dies_ok { Range::Validator::validate( $reversed ) } "expected to die with reverse range [$reversed]"; } #### my %test = ( '1,1..3' => [(1,2,3)], '1,2..5,4' => [(1,2,3,4,5)], '1..5,3' => [(1,2,3,4,5)], '8,9,1..2' => [(1,2,8,9)], '1..3,3,5..7' => [(1,2,3,5,6,7)], '5..7,1..6' => [(1,2,3,4,5,6,7)], '0..5,3' => [(0,1,2,3,4,5)] ); # ranges, even if overlapped or unordered, return the correct array foreach my $range ( keys %test ){ my @res = Range::Validator::validate($range); is_deeply( $test{$range},\@res, "correct result for range [$range]" ); } #### ok 15 - expected to die with reverse range [3..1,7..9] ok 16 - expected to die with reverse range [1..4,7..5] ok 17 - expected to die with reverse range [3..4, 7..5] ok 18 - expected to die with reverse range [0..2,27..5] ok 19 - correct result for range [1,2..5,4] ok 20 - correct result for range [1,1..3] ok 21 - correct result for range [0..5,3] ok 22 - correct result for range [5..7,1..6] ok 23 - correct result for range [1..3,3,5..7] ok 24 - correct result for range [8,9,1..2] ok 25 - correct result for range [1..5,3] #### git-client> git log HEAD --oneline c3f8d5b (HEAD -> master) test for overlappped or unordered ranges f16789a test for reversed ranges bb952ee (YourGithubLogin/master) removing duplicates from overlapping ranges 15a5f63 check for reverse ranges in string form 169809c changed regexes for 2 o lone dot and relative tests a6dc557 initial POD to document validate function 5083ec3 added 01-validate.t 580f628 some code into validate, added 01-validate.t and modified Makefile.PL 49a0690 moved POD, removed -T 1788c12 module-starter created content git-client> git show-branch *master * [master] test for overlappped or unordered ranges ! [refs/remotes/YourGithubLogin/master] removing duplicates from overlapping ranges -- * [master] test for overlappped or unordered ranges * [master^] test for reversed ranges *+ [refs/remotes/YourGithubLogin/master] removing duplicates from overlapping ranges git-client> git push YourGithubLogin master fatal: HttpRequestException encountered. Username for 'https://github.com': YourGithubLogin Password for 'https://YourGithubLogin@github.com': Counting objects: 8, done. Delta compression using up to 4 threads. Compressing objects: 100% (8/8), done. Writing objects: 100% (8/8), 1011 bytes | 505.00 KiB/s, done. Total 8 (delta 6), reused 0 (delta 0) remote: Resolving deltas: 100% (6/6), completed with 3 local objects. To https://github.com/YourGithubLogin/Range-Validator bb952ee..c3f8d5b master -> master git-client> git log HEAD --oneline c3f8d5b (HEAD -> master, YourGithubLogin/master) test for overlappped or unordered ranges f16789a test for reversed ranges bb952ee removing duplicates from overlapping ranges 15a5f63 check for reverse ranges in string form 169809c changed regexes for 2 o lone dot and relative tests a6dc557 initial POD to document validate function 5083ec3 added 01-validate.t 580f628 some code into validate, added 01-validate.t and modified Makefile.PL 49a0690 moved POD, removed -T 1788c12 module-starter created content git-client> git show-branch *master * [master] test for overlappped or unordered ranges ! [refs/remotes/YourGithubLogin/master] test for overlappped or unordered ranges -- *+ [master] test for overlappped or unordered ranges #### # otherwise we received a list else{ ... } #### sub validate{ my $range; my @range; # assume we have a string if we receive only one argument if ( @_ == 1){ $range = $_[0]; # remove any space from string $range =~ s/\s+//g; # die if invalid characters croak "invalid character passed in string [$range]!" if $range =~ /[^\s,.\d]/; # not allowed a lone . croak "invalid range [$range] (single .)!" if $range =~ /(? $2 in range [$range]" if $1 > $2; } } # eval the range @range = eval ($range); } # otherwise we received a list else{ @range = @_; } # remove duplicate elements using a hash my %single = map{ $_ => 1} @range; # sort unique keys numerically @range = sort{ $a <=> $b } keys %single; return @range; } #### Every string with occurences of a lone dot or more than two dots will be rejected causing an exception in the calling program. Reverse ranges like in '3..1' #### note ("starting test of list form"); my @test = ( # passed expected # correct ones [ [(0..3)], [(0,1,2,3)] ], [ [(0,1..3)], [(0,1,2,3)] ], [ [(0..3,5)], [(0,1,2,3,5)] ], # overlapped ones [ [(0..3,2)], [(0,1,2,3)] ], [ [(1,0..3)], [(0,1,2,3)] ], [ [(0..3,1..2)], [(0,1,2,3)] ], ); foreach my $list ( @test ){ my @res = Range::Validator::validate( @{$list->[0]} ); is_deeply( \@{$list->[1]},\@res, "correct result for list: @{$list->[0]}" ); } #### # all actions performed, no need to call our validate sub actions_to_activate_account(); # only reset password and send mail with new password my @valid_range = Range::Validator::validate(3,12); actions_to_activate_account( @valid_range ); # or in the string form: my $action_string = get_action_string_from_DB( actions => 'reset_pwd' ); # $action_string is '3,12' my @valid_range = Range::Validator::validate( $action_string ); actions_to_activate_account( @valid_range ); # or in the array form: my @actions = get_action_list_from_DB( actions => 'reset_pwd' ); # @actions is (3,12) my @valid_range = Range::Validator::validate( @actions ); actions_to_activate_account( @valid_range ); #### # assume we have a string if we receive only one argument if ( @_ == 1){ # STRING PART ... } elsif ( $WARNINGS == 1 and @_ == 0 ){ carp "Empty list passed in! We assume all element will be processed."; } # otherwise we received a list else{ # NON EMPTY LIST PART ... } #### BUILD_REQUIRES => { 'Test::More' => '0', 'Test::Exception' => '0', 'Capture::Tiny' => '0', # -- new line }, #### note ("test of warnings emitted"); { local $Range::Validator::WARNINGS; my ($stdout, $stderr, @result) = capture { Range::Validator::validate() }; unlike($stderr, qr/^Empty list passed in/, "no warning for empty list unless \$Range::Validator::WARNINGS"); $Range::Validator::WARNINGS = 1; ($stdout, $stderr, @result) = capture { Range::Validator::validate() }; like( $stderr, qr/^Empty list passed in/, "right warning for empty list if \$Range::Validator::WARNINGS"); } #### =head1 ENABLE WARNINGS If the $Range::Validator::WARNINGS #### shell> prove ./t/manifest.t ./t/manifest.t .. skipped: Author tests not required for installation Files=1, Tests=0, 0 wallclock secs ( 0.03 usr + 0.01 sys = 0.05 CPU) Result: NOTESTS #### shell> prove ./t/manifest.t ./t/manifest.t .. # Failed test at ./t/manifest.t line 15. ./t/manifest.t .. 1/1 # got: 0 # expected: 1 # The following files are not named in the MANIFEST file: .... # MANY LINES MORE.. #### shell> prove ./t/manifest.t ./t/manifest.t .. 1/1 # Failed test at ./t/manifest.t line 15. # got: 0 # expected: 1 # The following files are not named in the MANIFEST file: /path/to/your/module/ignore.txt, /path/to/your/module/MANIFEST.SKIP, /path/to/your/module/t/01-validate.t, /path/to/your/module/xt/boilerplate.t ... #### shell> prove ./xt/boilerplate.t ./xt/boilerplate.t .. ok All tests successful. Test Summary Report ------------------- ./xt/boilerplate.t (Wstat: 0 Tests: 3 Failed: 0) TODO passed: 3 Files=1, Tests=3, 1 wallclock secs ( 0.03 usr + 0.03 sys = 0.06 CPU) Result: PASS #### shell> prove ./t/manifest.t ./t/manifest.t .. ok All tests successful. Files=1, Tests=1, 1 wallclock secs ( 0.02 usr + 0.03 sys = 0.05 CPU) Result: PASS #### shell> prove -l -v ./t/pod.t ./t/pod.t .. 1..1 ok 1 - POD test for lib/Range/Validator.pm ok All tests successful. Files=1, Tests=1, 0 wallclock secs ( 0.03 usr + 0.02 sys = 0.05 CPU) Result: PASS shell> prove -l -v ./t/pod-coverage.t ./t/pod-coverage.t .. 1..1 ok 1 - Pod coverage on Range::Validator ok All tests successful. Files=1, Tests=1, 0 wallclock secs ( 0.03 usr + 0.02 sys = 0.05 CPU) Result: PASS #### git-client> git log HEAD --oneline --reverse 1788c12 module-starter created content 49a0690 moved POD, removed -T 580f628 some code into validate, added 01-validate.t and modified Makefile.PL 5083ec3 added 01-validate.t a6dc557 initial POD to document validate function 169809c changed regexes for 2 o lone dot and relative tests 15a5f63 check for reverse ranges in string form bb952ee removing duplicates from overlapping ranges f16789a test for reversed ranges c3f8d5b test for overlappped or unordered ranges 89174fe in the else block @range = @_ 58dbb12 moved string checks into the if (@_ == 1) block 8697b87 added POD for all string and list cecks e4f8eb1 added tests for lists 3efd7ce added $WARNING = 0 a46d6fc elsif block to catch empty @_ and carping under request 3e5993d Capture::Tiny in Makefile.pl ac22e82 test for warnings emitted 9667e22 POD for warnings 13f53eb MANIFEST.SKIP first line 99ab999 MANIFEST added MANIFEST.SKIP and 01-validate.t 61b7c9f removed ignore.txt e3feb61 removed xt/boilerplate.t 3c0da4f (HEAD -> master, YourGithubLogin/master) modified README #### package # hide from CPAN indexer testhelper; #### use lib '.'; use t::testhelper;