From: Tyler Riddle <t.riddle@shadowcat.co.uk>
Date: Fri, 28 Sep 2012 20:44:00 +0000 (-0700)
Subject: connection to gatherer now has a watchdog and gatherer runs probe via object::remote
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9ec68417b01997d69932a98ad418565c8ef1d309;p=scpubgit%2FSystem-Introspector.git

connection to gatherer now has a watchdog and gatherer runs probe via object::remote
---

diff --git a/lib/System/Introspector/Gatherer.pm b/lib/System/Introspector/Gatherer.pm
index 30eba49..9e92f2d 100644
--- a/lib/System/Introspector/Gatherer.pm
+++ b/lib/System/Introspector/Gatherer.pm
@@ -2,6 +2,7 @@ package System::Introspector::Gatherer;
 use Moo;
 use Object::Remote;
 use Object::Remote::Future;
+use Object::Remote::Connection;
 use System::Introspector::Gatherer::Bridge;
 use System::Introspector::Gatherer::Report;
 use Module::Runtime qw( use_module );
@@ -9,25 +10,6 @@ use System::Introspector::Logger qw( :log :dlog );
 
 has introspectors => (is => 'ro', required => 1);
 
-
-#the gatherer is the entry point on the remote host
-#where logging has not been initialized yet so
-#it must be initialized again before the probe can
-#run
-#TODO waiting to see if this really is never coming back
-#sub init_logging {
-#    my ($self, $log_level, $context) = @_; 
-#    System::Introspector::Logger->init_logging($context);
-#    return $self;
-#}
-
-sub ping {
-    my ($self) = @_; 
-    
-    log_trace { "Gatherer just got pinged" };
-    return 1; 
-}
-
 sub gather_all {
     my ($self) = @_;
     my $report = System::Introspector::Gatherer::Report->new; 
@@ -35,12 +17,14 @@ sub gather_all {
     log_trace { "gather_all() has been invoked" };
         
     for my $spec (@{ $self->introspectors }) {
+                
         my ($base, $args) = @$spec;
         my $module = "System::Introspector::Probe::$base";
         log_debug { "Using '$module' for this gather" };
         my $module_name = use_module($module);
         log_trace { "Finished loading '$module'; returned value was '$module_name'" };
-        my $instance = $module_name->new($args); 
+        my $instance = $module_name->new::on('-', $args);
+        #my $instance = $module_name->new($args);
         log_trace { "Finished constructing '$module_name'; starting gather" };
         my $probe_data = $instance->gather; 
         log_trace { "Gathering completed, storing data in the report for '$module_name'" };
@@ -80,16 +64,21 @@ sub new_from_spec {
     my $args = { introspectors => $arg{introspectors} };
     if (defined $host) {
         my $remote = join '@', grep defined, $user, $host;
+        my $conn = Object::Remote::Connection->conn_from_spec($remote, watchdog_timeout => 10);
+        $conn->maybe::start::connect;
         if (defined $sudo_user) {
-            return $class->_new_bridged($remote, $sudo, $args);
+            return $class->_new_bridged($conn->maybe::start::connect, $sudo, $args);
         }
         else {
-            return $class->_new_direct($remote, $args);
+            return $class->_new_direct($conn->maybe::start::connect, $args);
         }
     }
     else {
         if (defined $sudo_user) {
-            return $class->_new_direct($sudo, $args);
+            #TODO find a better way to achieve this result
+            my $conn = Object::Remote::Connection->conn_from_spec($sudo_user, watchdog_timeout => 10);
+            
+            return $class->_new_direct($conn->maybe::start::connect, $args);
         }
         else {
             return $class->new($args);
diff --git a/lib/System/Introspector/Probe/LibDirs/Perl.pm b/lib/System/Introspector/Probe/LibDirs/Perl.pm
index ddfb3af..2f2a4ed 100644
--- a/lib/System/Introspector/Probe/LibDirs/Perl.pm
+++ b/lib/System/Introspector/Probe/LibDirs/Perl.pm
@@ -19,11 +19,20 @@ has root => (
     default => sub { '/' },
 );
 
-has enumerate_packlists => ( is => 'ro', default => sub { 0 } );
+has enumerate_packlists => ( is => 'ro', default => sub { 1 } );
 
 sub gather {
     my ($self) = @_;
     log_debug { "Gathering Perl library information" }; 
+
+if (0) {
+   log_warn { "simulating hang" };
+
+    while(1) { 
+        sleep(1)
+    };
+}
+
     return transform_exceptions {
         my $pipe = $self->_open_locate_libdirs_pipe;
         my %libdir;
@@ -33,6 +42,7 @@ sub gather {
                 return { modules => $self->_gather_libdir_info($line) };
             };
         }
+
         log_trace { "Completed gathering Perl library information" }; 
         return { libdirs_perl => \%libdir };
     };
@@ -45,14 +55,19 @@ sub _gather_libdir_info {
     log_debug { "Gathering Perl libdir info for '$libdir'" };
 
     my $installed = ExtUtils::Installed->new(inc_override => [ $libdir ]);
-        
+            
     foreach my $module ($installed->modules) {
         my $packlist = $installed->packlist($module)->packlist_file;
         
         Dlog_trace { "Packlist file for '$module' in '$libdir' is '$_'" } $packlist;
-                
+                        
         $modules{$module} = {};
-                
+
+if (0) {
+  log_warn { "Simulating slowness" };
+  for(1 .. 20) { sleep(1) }
+}
+                        
         if ($self->enumerate_packlists && -f $packlist) {
             $modules{$module}->{packlist} = [ $installed->files($module, 'all') ];       
         }
@@ -110,8 +125,8 @@ sub _open_locate_libdirs_pipe {
     log_debug { "Executing 'locate' to identify Perl 5 library directories" };
     return handle_from_command sprintf
         #lib/perl5 for Local::Lib and debian installed perl? - lib/perl for others?
-#        q{locate --regex '^%s.*lib/perl$'}, $root;
-        q{locate --regex '^%s.*lib/perl5$'}, $root;
+        q{locate --regex '^%s.*lib/perl$'}, $root;
+#        q{locate --regex '^%s.*lib/perl5$'}, $root;
 }
 
 1;
diff --git a/lib/System/Introspector/Util.pm b/lib/System/Introspector/Util.pm
index d811a87..ccbc436 100644
--- a/lib/System/Introspector/Util.pm
+++ b/lib/System/Introspector/Util.pm
@@ -89,8 +89,8 @@ sub handle_from_command {
         my $out;
         my $child_pid;
         my @lines;
-        #have to temporarily out the signal so we can get the return
-        #value of the child process
+        #have to temporarily block out the signal so we can get the
+        #return value of the child process
         local($SIG{CHLD}) = undef;
         my ($err) = capture_stderr {
           $child_pid = open2($out, File::Spec->devnull, $command);
@@ -108,6 +108,10 @@ sub handle_from_command {
         open $pipe, '<', \$content;
         1;
     };
+    
+    #just in case any children exited while the waitpid() 
+    #was blocking before
+    kill('CHLD', $$);
     log_trace { "Completed reading output of '$command'" }; 
     unless ($ok) {
         my $err = $@;