Ensure we remove all paths that we created even if we terminate unexp…

…ectedly
kazuho · Jul 14, 2015 · b44e8cb · b44e8cb
1 parent 9b9c503
commit b44e8cb
Show file tree

Hide file tree

Showing 3 changed files with 36 additions and 16 deletions.
diff --git a/lib/Server/Starter.pm b/lib/Server/Starter.pm
@@ -150,6 +150,12 @@ sub start_server {
         }
         push @sock, $sock;
     }
+    my $path_remove_guard = Server::Starter::Guard->new(
+        sub {
+            -S $_ and unlink $_
+                for @$paths;
+        },
+    );
     for my $path (@$paths) {
         if (-S $path) {
             warn "removing existing socket file:$path";
@@ -217,6 +223,7 @@ sub start_server {
         die "fork failed:$!"
             unless defined $pid;
         if ($pid != 0) {
+            $path_remove_guard->dismiss;
             exit 0;
         }
         # in child process
@@ -225,6 +232,7 @@ sub start_server {
         die "fork failed:$!"
             unless defined $pid;
         if ($pid != 0) {
+            $path_remove_guard->dismiss;
             exit 0;
         }
         # do not close STDIN if `--port=n=0`.
@@ -235,13 +243,6 @@ sub start_server {
         }
     }
 
-    my $path_remove_guard = Server::Starter::Guard->new(
-        sub {
-            -S $_ and unlink $_
-                for @$paths;
-        },
-    );
-
     # open pid file
     my $pid_file_guard = sub {
         return unless $opts->{pid_file};

diff --git a/lib/Server/Starter/Guard.pm b/lib/Server/Starter/Guard.pm
@@ -5,12 +5,17 @@ use warnings;
 
 sub new {
     my ($klass, $handler) = @_;
-    return bless [ $handler ], $klass;
+    return bless {
+       handler => $handler,
+       active  => 1,
+   }, $klass;
 }
 
+sub dismiss { shift->{active} = 0 }
+
 sub DESTROY {
     my $self = shift;
-    $self->[0]->();
+    $self->{active} && $self->{handler}->();
 }
 
 1;
diff --git a/t/09-guard.t b/t/09-guard.t
@@ -4,14 +4,28 @@ use Test::More;
 
 use_ok("Server::Starter::Guard");
 
-my $cnt = 0;
+subtest "guard is called when it goes out of scope" => sub {
+    my $cnt = 0;
 
-my $guard = Server::Starter::Guard->new(sub {
-    $cnt++;
-});
+    my $guard = Server::Starter::Guard->new(sub {
+        $cnt++;
+    });
 
-is $cnt, 0;
-undef $guard;
-is $cnt, 1;
+    is $cnt, 0;
+    undef $guard;
+    is $cnt, 1;
+};
+
+subtest "guard can be dismissed" => sub {
+    my $cnt = 0;
+
+    my $guard = Server::Starter::Guard->new(sub {
+        $cnt++;
+    });
+
+    $guard->dismiss;
+    undef $guard;
+    is $cnt, 0;
+};
 
 done_testing;