-=pod
-
-=head1 NAME $RCSfile: Machines.pm,v $
-
-Abstraction of machines.
-
-=head1 VERSION
-
-=over
-
-=item Author
-
-Andrew DeFaria <Andrew@ClearSCM.com>
-
-=item Revision
-
-$Revision: 1.4 $
-
-=item Created
-
-Tue Jan 8 17:24:16 MST 2008
-
-=item Modified
-
-$Date: 2011/11/16 19:46:13 $
-
-=back
-
-=head1 SYNOPSIS
-
-This module handles the details of providing information about
-machines while obscuring the mechanism for storing such information.
-
- my $machines = Machines->new;
-
- foreach ($machine->all) {
- my %machine = %{$_};
- display "Machine: $machine{name}";
- disp.ay "Owner: $machine{owner}"
- } # if
-
-=head1 DESCRIPTION
-
-This module provides information about machines
-
-=head1 ROUTINES
-
-The following routines are exported:
-
-=cut
-
-package Machines;
-
-use strict;
-use warnings;
-
-use Display;
-use Utils;
-
-use base 'Exporter';
-
-our @EXPORT = qw (
- all
- new
-);
-
-sub new {
- my ($class, %parms) = @_;
-
-=pod
-
-=head2 new (<parms>)
-
-Construct a new Machines object. The following OO style arguments are
-supported:
-
-Parameters:
-
-=for html <blockquote>
-
-=over
-
-=item file:
-
-Name of an alternate file from which to read machine information. This
-is intended as a quick alternative.
-
-=back
-
-=for html </blockquote>
-
-Returns:
-
-=for html <blockquote>
-
-=over
-
-=item Machines object
-
-=back
-
-=for html </blockquote>
-
-=cut
-
- my $file = $parms{file} ? $parms{file} : "$FindBin::Bin/../etc/machines";
-
- error "Unable to find $file", 1 if ! -f $file;
-
- my %machines;
-
- foreach (ReadFile $file) {
- my @parts = split;
-
- # Skip commented out or blank lines
- next if $parts[0] =~ /^#/ or $parts[0] =~ /^$/;
-
- $machines{$parts[0]} = $parts[1];
- } # foreach
-
- bless {
- file => $parms {file},
- machines => \%machines,
- }, $class; # bless
-
- return $class;
-} # new
-
-sub all () {
- my ($self) = @_;
-
-=pod
-
-=head3 all ()
-
-Returns all known machines as an array of hashes
-
-Parameters:
-
-=for html <blockquote>
-
-=over
-
-=item none
-
-=back
-
-=for html </blockquote>
-
-Returns:
-
-=begin html
-
-<blockquote>
-
-=end html
-
-=over
-
-=item Array of machine hash records
-
-=back
-
-=for html </blockquote>
-
-=cut
-
- return %{$self->{machines}};
-} # display
-
-1;
-
-=pod
-
-=head1 CONFIGURATION AND ENVIRONMENT
-
-MACHINES: If set then points to a flat file containing machine
-names. Note this is providied as a way to quickly use an alternate
-"machine database". As such only minimal information is support.
-
-=head1 DEPENDENCIES
-
- Display
- Rexec
-
-=head1 INCOMPATABILITIES
-
-None yet...
-
-=head1 BUGS AND LIMITATIONS
-
-There are no known bugs in this module.
-
-Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
-
-=head1 LICENSE AND COPYRIGHT
-
-This Perl Module is freely available; you can redistribute it and/or
-modify it under the terms of the GNU General Public License as
-published by the Free Software Foundation; either version 2 of the
-License, or (at your option) any later version.
-
-This Perl Module is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-General Public License (L<http://www.gnu.org/copyleft/gpl.html>) for more
-details.
-
-You should have received a copy of the GNU General Public License
-along with this Perl Module; if not, write to the Free Software Foundation,
-Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-reserved.
-
-=cut
+=pod\r
+\r
+=head1 NAME $RCSfile: Machines.pm,v $\r
+\r
+Object oriented interface to list of managed machines\r
+\r
+=head1 VERSION\r
+\r
+=over\r
+\r
+=item Author:\r
+\r
+Andrew DeFaria <Andrew@DeFaria.com>\r
+\r
+=item Revision:\r
+\r
+$Revision: 1.0 $\r
+\r
+=item Created:\r
+\r
+Thu, Jul 12, 2018 5:11:44 PM\r
+\r
+=item Modified:\r
+\r
+$Date: $\r
+\r
+=back\r
+\r
+=head1 SYNOPSIS\r
+\r
+Perl module to specify a list of managed machines for rexec.pl\r
+\r
+ $machines = Machines->new (filename => "/opt/clearscm/data/machines");\r
+\r
+ my @machines = $machines->all;\r
+\r
+ my @linux_machines = $machines->select(condition => 'OS = "linux"');\r
+\r
+=head1 DESCRIPTION\r
+\r
+Machines is an OO interface to a list of managed machines. By default it parses\r
+a file that contains machine names and other identifying information.\r
+\r
+=head1 ROUTINES\r
+\r
+The following routines are exported:\r
+\r
+=cut\r
+\r
+package Machines;\r
+\r
+use strict;\r
+use warnings;\r
+\r
+use base 'Exporter';\r
+\r
+use Carp;\r
+\r
+sub _parseFile() {\r
+ my ($self) = @_;\r
+\r
+ my %machines;\r
+\r
+ # Simple parse for now\r
+ open my $machineFile, '<', $self->{filename}\r
+ or croak "Unable to open $self->{filename} - $!";\r
+\r
+ while (<$machineFile>) {\r
+ chomp;\r
+\r
+ next if /^#/; # Skip comments\r
+\r
+ my ($name, $model, $os, $ccver, $owner, $usage) = split /:/;\r
+\r
+ my %machineInfo = (\r
+ model => $model,\r
+ os => $os,\r
+ ccver => $ccver,\r
+ owner => $owner,\r
+ usage => $usage,\r
+ );\r
+\r
+ $machines{$name} = \%machineInfo;\r
+ } # while\r
+\r
+ close $machineFile;\r
+\r
+ return \%machines;\r
+} # _parseFile\r
+\r
+sub new(;%){\r
+ my ($class, %parms) = @_;\r
+\r
+=pod\r
+\r
+=head2 new (<parms>)\r
+\r
+Construct a new Machines object. The following OO style arguments are\r
+supported:\r
+\r
+Parameters:\r
+\r
+=for html <blockquote>\r
+\r
+=over\r
+\r
+=item filename:\r
+\r
+Filename to parse\r
+\r
+=item path:\r
+\r
+Path where file resides\r
+\r
+=back\r
+\r
+=for html </blockquote>\r
+\r
+Returns::\r
+\r
+=for html <blockquote>\r
+\r
+=over\r
+\r
+=item Machines object\r
+\r
+=back\r
+\r
+=for html </blockquote>\r
+\r
+=cut\r
+\r
+ $parms{filename} ||= 'machines';\r
+\r
+ if (! -r $parms{filename}) {\r
+ croak "Unable to read $parms{filename}";\r
+ } # if\r
+\r
+ my $self = bless {\r
+ filename => $parms{filename},\r
+ }, $class; # bless\r
+\r
+ # Parse file\r
+ $self->{machines} = $self->_parseFile;\r
+\r
+ return $self;\r
+} # new\r
+\r
+sub select(;$) {\r
+ my ($self, $condition) = @_;\r
+\r
+=pod\r
+\r
+=head3 select\r
+\r
+Return machines that qualify based on $condition\r
+\r
+Parameters:\r
+\r
+=for html <blockquote>\r
+\r
+=over\r
+\r
+=item $condition\r
+\r
+Condition to apply to machine list\r
+\r
+=back\r
+\r
+=for html </blockquote>\r
+\r
+Returns:\r
+\r
+=for html <blockquote>\r
+\r
+=over\r
+\r
+=item Array of qualifying machines\r
+\r
+=back\r
+\r
+=for html </blockquote>\r
+\r
+=cut\r
+\r
+ $condition //= '';\r
+\r
+ if ($condition) {\r
+ croak "Not supporting conditions yet";\r
+ } else {\r
+ return %{$self->{machines}};\r
+ } # if\r
+} # select\r
+\r
+sub GetSystem($) {\r
+ my ($self, $systemName) = @_;\r
+\r
+ return;\r
+} # getSystem\r
+\r
+sub AddSystem(%) {\r
+ my ($self, %system) = @_;\r
+\r
+ return;\r
+} # addSystem\r
+\r
+sub ChangeSystem(%){\r
+ my ($self, %system) = @_;\r
+\r
+ return;\r
+} # changeSystem\r
+\r
+sub DeleteSystem($) {\r
+ my ($self, $systemName) = @_;\r
+\r
+ return;\r
+} # deleteSystem\r
+\r
+sub DumpSystems(;$) {\r
+ my ($self, $filename) = @_;\r
+\r
+ $filename ||= 'machines';\r
+\r
+ open my $file, '>', $filename\r
+ or croak "Unable to open $filename for writing - $!";\r
+\r
+ # Write header\r
+ print $file <<"END";\r
+################################################################################\r
+#\r
+# File: $filename\r
+# Description: Dump of machines for use with rexec.pl\r
+# Author: Andrew\@DeFaria.com\r
+#\r
+################################################################################\r
+# Column 1 Machine name\r
+# Column 2 Alias\r
+# Column 3 Active\r
+# Column 4 Admin name\r
+# Column 5 Admin email\r
+# Column 6 OS version\r
+# Column 7 OS Type\r
+# Column 8 Last heard from\r
+# Column 9 Description\r
+END\r
+\r
+ # Write out machine info\r
+ my @fields = qw(name alias active admin email os type lastheardfrom description);\r
+\r
+ for my $record ($self->select) {\r
+ my %machine = %$record;\r
+\r
+ for (@fields) {\r
+ print $file "$machine{$_}|"\r
+ } # for\r
+\r
+ print $file "\n";\r
+ } # for\r
+\r
+ close $file;\r
+\r
+ return;\r
+} # DumpSystems\r
+\r
+sub ReadSystemsFile(;$) {\r
+ my ($self, $filename) = @_;\r
+\r
+ $filename ||= 'machines';\r
+\r
+ open my $file, '<', $filename\r
+ or croak "Unable to open $filename - $!";\r
+\r
+ my @systems;\r
+\r
+ while (<$file>) {\r
+ chomp;\r
+\r
+ next if /^#/;\r
+\r
+ my ($name, $model, $osver, $ccver, $owner, $usage) = split ':';\r
+ my %system = (\r
+ name => $name,\r
+ model => $model,\r
+ ccver => $ccver,\r
+ admin => $owner,\r
+ os => $osver,\r
+ type => 'Unix',\r
+ description => $usage,\r
+ );\r
+\r
+ push @systems, \%system;\r
+ } # while\r
+\r
+ close $file;\r
+\r
+ return @systems;\r
+} # ReadSystemsFile\r
+\r
+1;\r
+\r
+=pod\r
+\r
+=head2 CONFIGURATION AND ENVIRONMENT\r
+\r
+DEBUG: If set then $debug in this module is set.\r
+\r
+VERBOSE: If set then $verbose in this module is set.\r
+\r
+=head2 DEPENDENCIES\r
+\r
+=head3 Perl Modules\r
+\r
+L<File::Spec>\r
+\r
+L<IO::Handle>\r
+\r
+=head3 ClearSCM Perl Modules\r
+\r
+=for html <p><a href="/php/scm_man.php?file=lib/DateUtils.pm">DateUtils</a></p>\r
+\r
+=for html <p><a href="/php/scm_man.php?file=lib/Display.pm">Display</a></p>\r
+\r
+=for html <p><a href="/php/scm_man.php?file=lib/Mail.pm">Mail</a></p>\r
+\r
+=for html <p><a href="/php/scm_man.php?file=lib/OSDep.pm">OSDep</a></p>\r
+\r
+=for html <p><a href="/php/scm_man.php?file=lib/Utils.pm">Utils</a></p>\r
+\r
+=head2 INCOMPATABILITIES\r
+\r
+None yet...\r
+\r
+=head2 BUGS AND LIMITATIONS\r
+\r
+There are no known bugs in this module.\r
+\r
+Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.\r
+\r
+=head2 LICENSE AND COPYRIGHT\r
+\r
+This Perl Module is freely available; you can redistribute it and/or\r
+modify it under the terms of the GNU General Public License as\r
+published by the Free Software Foundation; either version 2 of the\r
+License, or (at your option) any later version.\r
+\r
+This Perl Module is distributed in the hope that it will be useful,\r
+but WITHOUT ANY WARRANTY; without even the implied warranty of\r
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\r
+General Public License (L<http://www.gnu.org/copyleft/gpl.html>) for more\r
+details.\r
+\r
+You should have received a copy of the GNU General Public License\r
+along with this Perl Module; if not, write to the Free Software Foundation,\r
+Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.\r
+reserved.\r
+\r
+=cut\r