3 =head1 NAME $RCSfile: Machines.pm,v $
\r
5 Object oriented interface to list of managed machines
\r
13 Andrew DeFaria <Andrew@DeFaria.com>
\r
21 Thu, Jul 12, 2018 5:11:44 PM
\r
31 Perl module to specify a list of managed machines for rexec.pl
\r
33 $machines = Machines->new (filename => "/opt/clearscm/data/machines");
\r
35 my @machines = $machines->all;
\r
37 my @linux_machines = $machines->select(condition => 'OS = "linux"');
\r
41 Machines is an OO interface to a list of managed machines. By default it parses
\r
42 a file that contains machine names and other identifying information.
\r
46 The following routines are exported:
\r
55 use base 'Exporter';
\r
64 # Simple parse for now
\r
65 open my $machineFile, '<', $self->{filename}
\r
66 or croak "Unable to open $self->{filename} - $!";
\r
68 while (<$machineFile>) {
\r
71 next if /^#/; # Skip comments
\r
73 my ($name, $model, $os, $ccver, $owner, $usage) = split /:/;
\r
83 $machines{$name} = \%machineInfo;
\r
92 my ($class, %parms) = @_;
\r
96 =head2 new (<parms>)
\r
98 Construct a new Machines object. The following OO style arguments are
\r
103 =for html <blockquote>
\r
113 Path where file resides
\r
117 =for html </blockquote>
\r
121 =for html <blockquote>
\r
125 =item Machines object
\r
129 =for html </blockquote>
\r
133 $parms{filename} ||= 'machines';
\r
135 if (! -r $parms{filename}) {
\r
136 croak "Unable to read $parms{filename}";
\r
140 filename => $parms{filename},
\r
144 $self->{machines} = $self->_parseFile;
\r
150 my ($self, $condition) = @_;
\r
156 Return machines that qualify based on $condition
\r
160 =for html <blockquote>
\r
166 Condition to apply to machine list
\r
170 =for html </blockquote>
\r
174 =for html <blockquote>
\r
178 =item Array of qualifying machines
\r
182 =for html </blockquote>
\r
189 croak "Not supporting conditions yet";
\r
191 return %{$self->{machines}};
\r
196 my ($self, $systemName) = @_;
\r
202 my ($self, %system) = @_;
\r
207 sub ChangeSystem(%){
\r
208 my ($self, %system) = @_;
\r
213 sub DeleteSystem($) {
\r
214 my ($self, $systemName) = @_;
\r
219 sub DumpSystems(;$) {
\r
220 my ($self, $filename) = @_;
\r
222 $filename ||= 'machines';
\r
224 open my $file, '>', $filename
\r
225 or croak "Unable to open $filename for writing - $!";
\r
228 print $file <<"END";
\r
229 ################################################################################
\r
232 # Description: Dump of machines for use with rexec.pl
\r
233 # Author: Andrew\@DeFaria.com
\r
235 ################################################################################
\r
236 # Column 1 Machine name
\r
239 # Column 4 Admin name
\r
240 # Column 5 Admin email
\r
241 # Column 6 OS version
\r
243 # Column 8 Last heard from
\r
244 # Column 9 Description
\r
247 # Write out machine info
\r
248 my @fields = qw(name alias active admin email os type lastheardfrom description);
\r
250 for my $record ($self->select) {
\r
251 my %machine = %$record;
\r
254 print $file "$machine{$_}|"
\r
265 sub ReadSystemsFile(;$) {
\r
266 my ($self, $filename) = @_;
\r
268 $filename ||= 'machines';
\r
270 open my $file, '<', $filename
\r
271 or croak "Unable to open $filename - $!";
\r
280 my ($name, $model, $osver, $ccver, $owner, $usage) = split ':';
\r
288 description => $usage,
\r
291 push @systems, \%system;
\r
297 } # ReadSystemsFile
\r
303 =head2 CONFIGURATION AND ENVIRONMENT
\r
305 DEBUG: If set then $debug in this module is set.
\r
307 VERBOSE: If set then $verbose in this module is set.
\r
309 =head2 DEPENDENCIES
\r
311 =head3 Perl Modules
\r
317 =head3 ClearSCM Perl Modules
\r
319 =for html <p><a href="/php/scm_man.php?file=lib/DateUtils.pm">DateUtils</a></p>
\r
321 =for html <p><a href="/php/scm_man.php?file=lib/Display.pm">Display</a></p>
\r
323 =for html <p><a href="/php/scm_man.php?file=lib/Mail.pm">Mail</a></p>
\r
325 =for html <p><a href="/php/scm_man.php?file=lib/OSDep.pm">OSDep</a></p>
\r
327 =for html <p><a href="/php/scm_man.php?file=lib/Utils.pm">Utils</a></p>
\r
329 =head2 INCOMPATABILITIES
\r
333 =head2 BUGS AND LIMITATIONS
\r
335 There are no known bugs in this module.
\r
337 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
\r
339 =head2 LICENSE AND COPYRIGHT
\r
341 This Perl Module is freely available; you can redistribute it and/or
\r
342 modify it under the terms of the GNU General Public License as
\r
343 published by the Free Software Foundation; either version 2 of the
\r
344 License, or (at your option) any later version.
\r
346 This Perl Module is distributed in the hope that it will be useful,
\r
347 but WITHOUT ANY WARRANTY; without even the implied warranty of
\r
348 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
\r
349 General Public License (L<http://www.gnu.org/copyleft/gpl.html>) for more
\r
352 You should have received a copy of the GNU General Public License
\r
353 along with this Perl Module; if not, write to the Free Software Foundation,
\r
354 Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
\r