Make polling interval configurable

And use it to speed up unit tests

Author: mgreter

lib/Filesys/Notify/Simple.pm

@@ -3,6 +3,7 @@ package Filesys::Notify::Simple;
 use strict;
 use 5.008_001;
 our $VERSION = '0.12';
+our $interval = 2.0;
 
 use Carp ();
 use Cwd;
@@ -159,7 +160,8 @@ sub wait_timer {
         my $cb = shift;
         my @events;
         while (1) {
-            sleep 2;
+            # sleep 0 is needed to fix sigalrm on windows!?
+            select undef, undef, undef, $interval && sleep 0;
             my $new_fs = _full_scan(@path);
             _compare_fs($fs, $new_fs, sub { push @events, { path => $_[0] } });
             $fs = $new_fs;

t/empty_dir.t

@@ -10,29 +10,30 @@ plan tests => 6;
 
 my $dir = tempdir( DIR => "$FindBin::Bin/x" );
 my $w = Filesys::Notify::Simple->new([ "$dir" ]);
+$Filesys::Notify::Simple::interval = 0.5;
 
 mkdir "$dir/root";
 
 
 my $pid = fork;
 if ($pid == 0) {
     Test::SharedFork->child;
-    sleep 3;
+    sleep 1;
     note "mkdir subroot\n";
     mkdir "$dir/subroot";
-    sleep 3;
+    sleep 1;
     note "mkdir subroot/deep\n";
     mkdir "$dir/subroot/deep";
-    sleep 3;
+    sleep 1;
     note "mkdir subroot/deep/down\n";
     mkdir "$dir/subroot/deep/down";
-    sleep 3;
+    sleep 1;
     note "rmdir subroot/deep/down\n";
     rmdir "$dir/subroot/deep/down";
-    sleep 3;
+    sleep 1;
     note "rmdir subroot/deep\n";
     rmdir "$dir/subroot/deep";
-    sleep 3;
+    sleep 1;
     note "rmdir subroot\n";
     rmdir "$dir/subroot";
 } elsif ($pid != 0) {

t/move.t

@@ -10,6 +10,7 @@ plan tests => 2;
 
 my $dir = tempdir( DIR => "$FindBin::Bin/x" );
 my $w = Filesys::Notify::Simple->new([ "lib", "$dir" ]);
+$Filesys::Notify::Simple::interval = 0.5;
 
 my $test_file = "$dir/move_create.data";
 my $test_file_to = "$dir/move_create.data.to";
@@ -18,11 +19,11 @@ my $test_file_to = "$dir/move_create.data.to";
 my $pid = fork;
 if ($pid == 0) {
     Test::SharedFork->child;
-    sleep 3;
+    sleep 1;
     open my $out, ">", $test_file;
     print $out "foo" . time;
     close $out;
-    sleep 3;
+    sleep 1;
     rename($test_file => $test_file_to);
 } elsif ($pid != 0) {
     Test::SharedFork->parent;

t/non_existent_path.t

@@ -5,6 +5,7 @@ $ENV{PERL_FNS_NO_OPT} = 1;
 require Filesys::Notify::Simple;
 
 my $fs = Filesys::Notify::Simple->new(["/xxx/nonexistent"]);
+$Filesys::Notify::Simple::interval = 0.5;
 
 eval {
     $SIG{ALRM} = sub { die "Alarm\n" };

t/rm_create.t

@@ -6,6 +6,7 @@ use FindBin;
 use File::Temp qw( tempdir );
 
 my $dir = tempdir( DIR => "$FindBin::Bin/x" );
+$Filesys::Notify::Simple::interval = 0.5;
 
 
 plan tests => 2;
@@ -15,12 +16,12 @@ my $w = Filesys::Notify::Simple->new([ "lib", "$dir" ]);
 my $pid = fork;
 if ($pid == 0) {
     Test::SharedFork->child;
-    sleep 3;
+    sleep 1;
     my $test_file = "$dir/rm_create.data";
     open my $out, ">", $test_file;
     print $out "foo" . time;
     close $out;
-    sleep 3;
+    sleep 1;
     unlink $test_file;
 } elsif ($pid != 0) {
     Test::SharedFork->parent;