From: Sebastian Riedel <sri@labs.kraih.com>
Date: Mon, 17 Oct 2005 15:21:52 +0000 (+0000)
Subject: Updated to half working restarter with syntax check
X-Git-Tag: 5.7099_04~1209
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=7a1df40307d6825f3daac351c330fbd235cf9a47

Updated to half working restarter with syntax check
---

diff --git a/lib/Catalyst/Engine/HTTP.pm b/lib/Catalyst/Engine/HTTP.pm
index 214877d..77bb798 100644
--- a/lib/Catalyst/Engine/HTTP.pm
+++ b/lib/Catalyst/Engine/HTTP.pm
@@ -123,18 +123,40 @@ sub run {
         my $parent = $$;
         unless ( $restarter = fork ) {
 
+            # Prepare
+            close STDIN;
+            close STDOUT;
+
             # Index parent directory
             my $dir = File::Spec->catdir( $FindBin::Bin, '..' );
 
             my $regex = $options->{restart_regex};
-            my $one = _index( $dir, $regex );
-            while (1) {
+            my $one   = _index( $dir, $regex );
+          RESTART: while (1) {
                 sleep $options->{restart_delay};
-                my $two = _index( $dir, $regex );
-                if ( my $file = _compare_index( $one, $two ) ) {
-                    print STDERR qq/File "$file" modified, restarting\n/;
-                    kill( 1, $parent );
+                my $two     = _index( $dir,         $regex );
+                my $changes = _compare_index( $one, $two );
+                if (@$changes) {
                     $one = $two;
+
+                    # Test modified pm's
+                    for my $file (@$changes) {
+                        next unless $file =~ /\.pm$/;
+                        if ( my $error = _test($file) ) {
+                            print STDERR
+                              qq/File "$file" modified, not restarting\n/;
+                            print STDERR '*' x 80, "\n";
+                            print STDERR $error;
+                            print STDERR '*' x 80, "\n";
+                            next RESTART;
+                        }
+                    }
+
+                    # Restart
+                    my $files = join ', ', @$changes;
+                    print STDERR qq/File(s) "$files" modified, restarting\n/;
+                    kill( 1, $parent );
+                    exit;
                 }
             }
         }
@@ -252,14 +274,15 @@ sub run {
 sub _compare_index {
     my ( $one, $two ) = @_;
     my %clone = %$two;
+    my @changes;
     while ( my ( $key, $val ) = each %$one ) {
-        return $key if ( !$clone{$key} || ( $clone{$key} ne $val ) );
+        if ( !$clone{$key} || ( $clone{$key} ne $val ) ) {
+            push @changes, $key;
+        }
         delete $clone{$key};
     }
-    if ( keys %clone ) {
-        return join ' ', keys %clone;
-    }
-    return 0;
+    for my $key ( keys %clone ) { push @changes, $key }
+    return \@changes;
 }
 
 sub _get_line {
@@ -296,6 +319,17 @@ sub _index {
     return \%index;
 }
 
+sub _test {
+    my $file = shift;
+    local $SIG{__WARN__} = sub { };
+    open my $olderr, '>&STDERR';
+    open STDERR, '>', File::Spec->devnull;
+    eval "require '$file'";
+    open STDERR, '>&', $olderr;
+    return $@ if $@;
+    return 0;
+}
+
 =back
 
 =head1 SEE ALSO