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
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 }) {
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 {
--- /dev/null
+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;
+
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);
#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" };
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;
} 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" };
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
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>;
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;