move to a gatherer report for the probe data, gatherer report can use tied objects...
Tyler Riddle [Tue, 25 Sep 2012 18:40:16 +0000 (11:40 -0700)]
lib/System/Introspector/Gatherer.pm
lib/System/Introspector/Gatherer/Report.pm [new file with mode: 0644]
lib/System/Introspector/State.pm
lib/System/Introspector/Util.pm

index be9b393..3fa7cc5 100644 (file)
@@ -3,11 +3,13 @@ use Moo;
 use Object::Remote;
 use Object::Remote::Future;
 use System::Introspector::Gatherer::Bridge;
+use System::Introspector::Gatherer::Report;
 use Module::Runtime qw( use_module );
 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
@@ -21,8 +23,8 @@ has introspectors => (is => 'ro', required => 1);
 
 sub gather_all {
     my ($self) = @_;
-    my %report;
-    
+    my $report = System::Introspector::Gatherer::Report->new; 
+        
     log_trace { "gather_all() has been invoked" };
         
     for my $spec (@{ $self->introspectors }) {
@@ -32,21 +34,16 @@ sub gather_all {
         my $module_name = use_module($module);
         log_trace { "Finished loading '$module'; returned value was '$module_name'" };
         my $instance = $module_name->new($args); 
-        log_trace { "Finished constructing '$module_name'" };
-        $report{$base} = $instance->gather; 
-        log_trace { "Finished invocation of '$module_name->gather()'" };  
+        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'" };
+        $report->add_probe_data($base, $probe_data);
+        log_trace { "Stored data in report; gather iteration for '$module_name' is done" };  
     }
     
     log_trace { "gather_all() has completed" };
  
-    #TODO easiest way to solve problem with huge
-    #JSON looks like it would be to hand back
-    #a report object with methods that access
-    #the individual parts of the report. That
-    #way the transfer will happen in chunks
-    #as _store in ::Stage pulls in the
-    #results    
-    return \%report;
+    return $report;  
 }
 
 sub _new_direct {
diff --git a/lib/System/Introspector/Gatherer/Report.pm b/lib/System/Introspector/Gatherer/Report.pm
new file mode 100644 (file)
index 0000000..a909f52
--- /dev/null
@@ -0,0 +1,104 @@
+package System::Introspector::Gatherer::Report::Hash;
+
+use strictures 1; 
+use Tie::Hash;
+use Scalar::Util qw(reftype blessed);  
+use System::Introspector::Logger qw( :log :dlog );
+our @ISA = qw(Tie::StdHash);
+
+sub TIEHASH {
+    log_trace { "tieing report data to hash" };
+    return bless({}, $_[0]);
+}
+
+sub FETCH {
+    my ($self, $key) = @_; 
+    
+    log_trace { "fetching value in tied report hash for key '$key'" };
+    #return $self->{$key};
+    return $self->_anonymous_tie($self->{$key});
+}
+
+sub _anonymous_tie {
+    my ($self, $data) = @_; 
+        
+    return $data if blessed($data);
+    return $data if tied($data);
+
+    my $type = reftype($data);
+    return $data unless $type;
+            
+    if ($type eq 'HASH') {
+        tie(my %tied, 'System::Introspector::Gatherer::Report::Hash');
+        %tied = %$data; 
+        return \%tied; 
+    } elsif ($type eq 'ARRAY') {
+        tie(my @tied, 'System::Introspector::Gatherer::Report::Array');
+        @tied = @$data; 
+        return \@tied;         
+    }      
+
+    return $data;  
+}
+
+1;
+
+package System::Introspector::Gatherer::Report::Array; 
+
+use strictures 1; 
+use Tie::Array;
+use Scalar::Util qw(reftype blessed);  
+use System::Introspector::Logger qw( :log :dlog );
+
+our @ISA = qw(Tie::StdArray);
+
+sub TIEARRAY {
+    log_trace { "tieing report data to array" };
+    return bless([], $_[0]);
+}
+
+sub FETCH {
+    my ($self, $index) = @_; 
+    
+    log_trace { "fetching value in report array for index '$index'" };
+    
+    #return $self->[$index];
+    return System::Introspector::Gatherer::Report::Hash->_anonymous_tie($self->[$index]);
+}
+
+1;
+
+package System::Introspector::Gatherer::Report;
+use System::Introspector::Logger qw( :log :dlog );
+
+use Moo;
+
+has data => ( is => 'ro', required => 1, default => sub { {} } );
+has tied_output => ( is => 'ro', required => 1, default => sub { 0 } );
+
+#return list of class names in report
+sub probe_names {
+  my ($self) = @_; 
+  return Dlog_trace { "Probe report has the following probe names: $_"  } 
+    sort keys %{ $self->{data} };
+}
+
+sub add_probe_data {
+    my ($self, $name, $data) = @_;
+    log_trace { "Adding report data for probe name '$name'" };
+    $self->data->{$name} = $data;
+    return $self; 
+}
+
+#get data for the class by it's name
+sub get_probe_data {
+  my ($self, $name) = @_;
+  log_trace { "Getting report data for probe name '$name'" };
+  my $data = $self->data->{$name};
+  return $data unless $self->tied_output;
+  log_info { "Probe data is coming from tied objects" };
+  return System::Introspector::Gatherer::Report::Hash->_anonymous_tie($data); 
+}
+
+1;
+
index c4d5a41..82e6c33 100644 (file)
@@ -1,10 +1,11 @@
 package System::Introspector::State;
 use Moo;
 use File::Tree::Snapshot;
-use System::Introspector::Gatherer;
 use Object::Remote::Future qw( await_all );
 use JSON::Diffable qw( encode_json );
-use System::Introspector::Logger qw( :log );
+use System::Introspector::Gatherer;
+use System::Introspector::Logger qw( :log :dlog );
+use System::Introspector::Report;
 
 has config => (is => 'ro', required => 1);
 
@@ -41,9 +42,11 @@ sub gather {
             #they complete - it would cause less RAM consumption for the
             #system as a whole but requires modifying the future based
             #syncronization logic
-            my @data = await_all @futures;
+            my ($report) = await_all @futures;
+#            die Dumper($report_proxy); use Data::Dumper; 
             log_trace { "Received all from group '$group' on '$host'" };
-            $self->_store($host, $group, +{ map %$_, @data });
+#            $self->_store($host, $group, +{ map %$_, @data });
+            $self->_store($host, $group, $report);
         }
     }   
     log_debug { "Completed gathering results" };
@@ -102,7 +105,9 @@ sub _store {
     my $storage = $self->storage($host, $group);
     my $ok = eval {
         my @files;
-        for my $class (sort keys %$gathered) {
+#        for my $class (sort keys %$gathered) {
+        for my $class ($gathered->probe_names) {
+            log_trace { "Storing data for probe name '$class'" };
             my $file = sprintf '%s.json', join '/',
                 map lc, map {
                     s{([a-z0-9])([A-Z])}{${1}_${2}}g;
@@ -110,9 +115,12 @@ sub _store {
                 } split m{::}, $class;
             my $fh = $storage->open('>:utf8', $file, mkpath => 1);
             my $full_path = $storage->file($file);
-            log_trace { "Writing state to '$full_path'" };
-            print $fh encode_json($gathered->{$class});
+            my $data = $gathered->get_probe_data($class);
+            log_debug { "Generated file name for storage: '$file'; Writing state to '$full_path'" };
+            Dlog_trace { "Input to storage engine: $_" } $data; 
+            print $fh encode_json($gathered->get_probe_data($class));
             push @files, $full_path;
+            log_trace { "Finished storing data for '$class'" }; 
         }
         $self->_cleanup($storage, [@files]);
         log_trace { "Comitting stored data" };
index 6614357..d811a87 100644 (file)
@@ -61,7 +61,7 @@ sub output_from_command {
         unless defined $in;
     my ($out, $err) = ('', '');
     Dlog_trace { "executing command with IPC::Run: $_" } @$command;
-    my $ok = eval { run($command, \$in, \$out, \$err) or die $err};
+    my $ok = eval { run($command, \$in, \$out, \$err); 1 };
     log_trace { $ok ? "command executed successfully" : "command did not execute successfully" };
     $err = $@ unless $ok;
     return $out, $err, $ok
@@ -89,6 +89,9 @@ 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
+        local($SIG{CHLD}) = undef;
         my ($err) = capture_stderr {
           $child_pid = open2($out, File::Spec->devnull, $command);
           @lines = <$out>;
@@ -99,6 +102,7 @@ sub handle_from_command {
         my $status = $? >> 8;
         $err = "Unknown error"
             unless defined $err;
+        log_trace { my $l = scalar(@lines); my $c = length($content); "Read '$l' lines and '$c' characters from the command; status: '$status'" };
         fail "Command error ($command): $err\n"
             if $status;
         open $pipe, '<', \$content;