capture origin/<name> of active branch in case remote is not tracked
[scpubgit/System-Introspector.git] / lib / System / Introspector / State.pm
CommitLineData
60e1cc39 1package System::Introspector::State;
2use Moo;
b079a95d 3use File::Tree::Snapshot;
60e1cc39 4use System::Introspector::Gatherer;
949dba9c 5use Object::Remote::Future qw( await_all );
60e1cc39 6
0a11cf83 7use JSON::Diffable qw( encode_json );
8
60e1cc39 9has config => (is => 'ro', required => 1);
10
b079a95d 11has root => (is => 'ro', required => 1);
60e1cc39 12
b079a95d 13sub user { $_[0]->config->user }
60e1cc39 14
b079a95d 15sub sudo_user { $_[0]->config->sudo_user }
a5e1e1c6 16
949dba9c 17sub _log { shift; printf "[%s] %s\n", scalar(localtime), join '', @_ }
18
b079a95d 19sub gather {
20 my ($self, @groups) = @_;
949dba9c 21 $self->_log('Start');
22 for my $group (@groups) {
23 my @waiting;
24 for my $host ($self->config->hosts) {
25 $self->_log("Beginning to fetch group '$group' on '$host'");
26 push @waiting, [$host, $self->fetch($host, $group)];
27 }
28 $self->_log("Now waiting for results");
4e690962 29 for my $wait (@waiting) {
bd4f6141 30 my ($host, @futures) = @$wait;
4e690962 31 my @data = await_all @futures;
949dba9c 32 $self->_log("Received all from group '$group' on '$host'");
949dba9c 33 $self->_store($host, $group, +{ map %$_, @data });
34 }
b079a95d 35 }
949dba9c 36 $self->_log('Done');
b079a95d 37 return 1;
38}
a5e1e1c6 39
b079a95d 40sub introspectors {
41 my ($self, $group) = @_;
42 return $self->config->config_for_group($group)->{introspect};
43}
60e1cc39 44
60e1cc39 45sub fetch {
b079a95d 46 my ($self, $host, $group) = @_;
47 my $spec = $self->introspectors($group);
a5e1e1c6 48 my (@sudo, @nosudo);
49 push(@{ $spec->{$_}{sudo} ? \@sudo : \@nosudo}, [$_, $spec->{$_}])
50 for sort keys %$spec;
949dba9c 51 my @futures;
a5e1e1c6 52 if (@nosudo) {
949dba9c 53 $self->_log("Without sudo: ", join ", ", map $_->[0], @nosudo);
54 my $proxy = $self->_create_gatherer(
55 host => $host,
56 introspectors => [@nosudo],
57 );
58 push @futures, $proxy->start::gather_all;
a5e1e1c6 59 }
60 if (@sudo) {
949dba9c 61 $self->_log("With sudo: ", join ", ", map $_->[0], @nosudo);
62 my $proxy = $self->_create_gatherer(
63 sudo => 1,
64 host => $host,
65 introspectors => [@sudo],
66 );
67 push @futures, $proxy->start::gather_all;
60e1cc39 68 }
949dba9c 69 return @futures;
60e1cc39 70}
71
b079a95d 72sub storage {
73 my ($self, @path) = @_;
74 my $storage = File::Tree::Snapshot->new(
75 allow_empty => 0,
76 storage_path => join('/', $self->root, @path),
77 );
78 $storage->create
79 unless $storage->exists;
80 return $storage;
60e1cc39 81}
82
83sub _store {
949dba9c 84 my ($self, $host, $group, $gathered) = @_;
e56ead13 85 $self->_log("Storing data for group '$group' on '$host'");
949dba9c 86 my $storage = $self->storage($host, $group);
87 my $ok = eval {
b079a95d 88 my @files;
89 for my $class (sort keys %$gathered) {
90 my $file = sprintf '%s.json', join '/',
91 map lc, map {
92 s{([a-z0-9])([A-Z])}{${1}_${2}}g;
93 $_;
94 } split m{::}, $class;
95 my $fh = $storage->open('>:utf8', $file, mkpath => 1);
949dba9c 96 my $full_path = $storage->file($file);
97 $self->_log("Writing $full_path");
b079a95d 98 print $fh encode_json($gathered->{$class});
949dba9c 99 push @files, $full_path;
b079a95d 100 }
101 $self->_cleanup($storage, [@files]);
949dba9c 102 $self->_log("Committing");
b079a95d 103 $storage->commit;
949dba9c 104 };
105 unless ($ok) {
106 $self->_log("Rolling back snapshot because of: ", $@ || 'unknown error');
107 $storage->rollback;
108 die $@;
60e1cc39 109 }
60e1cc39 110 return 1;
111}
112
113sub _cleanup {
b079a95d 114 my ($self, $storage, $known_files) = @_;
60e1cc39 115 my %known = map { ($_ => 1) } @$known_files;
b079a95d 116 my @files = $storage->find_files('json');
60e1cc39 117 for my $file (@files) {
118 next if $known{$file};
949dba9c 119 $self->_log("Removing $file");
60e1cc39 120 unlink($file)
121 or die "Unable to remove '$file': $!\n";
122 }
123 return 1;
124}
125
126sub _create_gatherer {
a5e1e1c6 127 my ($self, %arg) = @_;
128 return System::Introspector::Gatherer->new_from_spec(
949dba9c 129 user => $self->user,
130 host => $arg{host},
131 sudo_user => $arg{sudo} && $self->sudo_user,
132 introspectors => $arg{introspectors},
a5e1e1c6 133 );
60e1cc39 134}
135
1361;
cd5c3d43 137
138=head1 NAME
139
140System::Introspector::State - Gather system state
141
142=head1 SYNOPSIS
143
144 my $state = System::Introspector::State->new(
f24afb0e 145 root => '/root/path',
146 config => $config_object,
cd5c3d43 147 );
148
f24afb0e 149 $state->gather;
cd5c3d43 150
151=head1 DESCRIPTION
152
153Gathers system introspection data based on configuration and stores
154it with a L<File::Tree::Snapshot> object.
155
156=head1 ATTRIBUTES
157
158=head2 config
159
f24afb0e 160A L<System::Introspector::Config>
cd5c3d43 161
f24afb0e 162=head2 root
cd5c3d43 163
f24afb0e 164Path to the storage root.
cd5c3d43 165
f24afb0e 166=head1 METHODS
cd5c3d43 167
f24afb0e 168=head2 gather
cd5c3d43 169
f24afb0e 170 $state->gather;
171
172Fetches all probe data and stores it in the tree below the L</root>.
173
174=head1 SEE ALSO
175
176=over
cd5c3d43 177
f24afb0e 178=item L<System::Introspector>
cd5c3d43 179
f24afb0e 180=back
cd5c3d43 181
f24afb0e 182=head1 COPYRIGHT
cd5c3d43 183
f24afb0e 184Copyright (c) 2012 the L<System::Introspector>
185L<AUTHOR|System::Introspector/AUTHOR>,
186L<CONTRIBUTORS|System::Introspector/CONTRIBUTORS> and
187L<SPONSORS|System::Introspector/SPONSORS>.
cd5c3d43 188
f24afb0e 189=head1 LICENSE
cd5c3d43 190
f24afb0e 191This library is free software and may be distributed under the same terms
192as perl itself.
cd5c3d43 193
194=cut