-=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 Carp;
-use DBI;
-use FindBin;
-
-use DateUtils;
-use Display;
-use GetConfig;
-
-our %MACHINESOPTS = GetConfig ("$FindBin::Bin/../etc/machines.conf");
-
-my $defaultFilesystemThreshold = 90;
-my $defaultFilesystemHist = '6 months';
-my $defaultLoadavgHist = '6 months';
-
-# Internal methods
-sub _dberror ($$) {
- my ($self, $msg, $statement) = @_;
-
- my $dberr = $self->{db}->err;
- my $dberrmsg = $self->{db}->errstr;
-
- $dberr ||= 0;
- $dberrmsg ||= 'Success';
-
- my $message = '';
-
- if ($dberr) {
- my $function = (caller (1)) [3];
-
- $message = "$function: $msg\nError #$dberr: $dberrmsg\n"
- . "SQL Statement: $statement";
- } # if
-
- return $dberr, $message;
-} # _dberror
-
-sub _formatValues (@) {
- my ($self, @values) = @_;
-
- my @returnValues;
-
- # Quote data values
- push @returnValues, $_ eq '' ? 'null' : $self->{db}->quote ($_)
- foreach (@values);
-
- return @returnValues;
-} # _formatValues
-
-sub _formatNameValues (%) {
- my ($self, %rec) = @_;
-
- my @nameValueStrs;
-
- push @nameValueStrs, "$_=" . $self->{db}->quote ($rec{$_})
- foreach (keys %rec);
-
- return @nameValueStrs;
-} # _formatNameValues
-
-sub _error () {\r
- my ($self) = @_;
-
- if ($self->{msg}) {
- if ($self->{errno}) {
- carp $self->{msg};
- } else {
- cluck $self->{msg};
- } # if
+=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
-} # _error
-
-sub _addRecord ($%) {
- my ($self, $table, %rec) = @_;
-
- my $statement = "insert into $table (";
- $statement .= join ',', keys %rec;
- $statement .= ') values (';
- $statement .= join ',', $self->_formatValues (values %rec);
- $statement .= ')';
-
- my ($err, $msg);
-
- $self->{db}->do ($statement);
-
- return $self->_dberror ("Unable to add record to $table", $statement);
-} # _addRecord
-
-sub _checkRequiredFields ($$) {
- my ($fields, $rec) = @_;
-
- foreach my $fieldname (@$fields) {
- my $found = 0;
-
- foreach (keys %$rec) {
- if ($fieldname eq $_) {
- $found = 1;
- last;
- } # if
- } # foreach
-
- return "$fieldname is required"
- unless $found;
- } # foreach
-
- return;
-} # _checkRequiredFields
-
-sub _connect (;$) {
- my ($self, $dbserver) = @_;
-
- $dbserver ||= $MACHINESOPTS{MACHINES_SERVER};
-
- my $dbname = 'machines';
- my $dbdriver = 'mysql';
-
- $self->{db} = DBI->connect (
- "DBI:$dbdriver:$dbname:$dbserver",
- $MACHINESOPTS{MACHINES_USERNAME},
- $MACHINESOPTS{MACHINES_PASSWORD},
- {PrintError => 0},
- ) or croak (
- "Couldn't connect to $dbname database "
- . "as $MACHINESOPTS{MACHINESADM_USERNAME}\@$MACHINESOPTS{MACHINESADM_SERVER}"
- );
-
- $self->{dbserver} = $dbserver;
-
- return;
-} # _connect
-
-sub _getRecords ($$) {
- my ($self, $table, $condition) = @_;
-
- my ($err, $msg);
-
- my $statement = "select * from $table where $condition";
-
- my $sth = $self->{db}->prepare ($statement);
-
- unless ($sth) {
- ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
-
- croak $msg;
- } # if
-
- my $attempts = 0;
- my $maxAttempts = 3;
- my $sleepTime = 30;
- my $status;
-
- # We've been having the server going away. Supposedly it should reconnect so
- # here we simply retry up to $maxAttempts times to re-execute the statement.
- # (Are there other places where we need to do this?)
- $err = 2006;
-
- while ($err == 2006 and $attempts++ < $maxAttempts) {
- $status = $sth->execute;
-
- if ($status) {
- $err = 0;
- last;
- } else {
- ($err, $msg) = $self->_dberror ('Unable to execute statement',
- $statement);
- } # if
-
- last if $err == 0;
-
- croak $msg unless $err == 2006;
-
- my $timestamp = YMDHMS;
-
- $self->Error ("$timestamp: Unable to talk to DB server.\n\n$msg\n\n"
- . "Will try again in $sleepTime seconds", -1);
-
- # Try to reconnect
- $self->_connect ($self->{dbserver});
-
- sleep $sleepTime;
- } # while
-
- $self->Error ("After $maxAttempts attempts I could not connect to the database", $err)
- if ($err == 2006 and $attempts > $maxAttempts);
-
- my @records;
-
- while (my $row = $sth->fetchrow_hashref) {
- push @records, $row;
- } # while
-
- return @records;
-} # _getRecord
-
-
-sub new {
- my ($class, %parms) = @_;
-
-=pod
-
-=head2 new ($server)
-
-Construct a new Machines object.
-
-=cut
-
- # Merge %parms with %MACHINEOPTS
- foreach (keys %parms) {
- $MACHINESOPTS{$_} = $parms{$_};
- } # foreach;
-
- my $self = bless {}, $class;
-
- $self->_connect ();
-
- return $self;
-} # new
-
-sub add (%) {
- my ($self, %system) = @_;
-
- my @requiredFields = qw(
- name
- admin
- type
- );
-
- my $result = _checkRequiredFields \@requiredFields, \%system;
-
- return -1, "add: $result" if $result;
-
- $system{loadavgHist} ||= $defaultLoadavgHist;
-
- return $self->_addRecord ('system', %system);
-} # add
-
-sub delete ($) {
- my ($self, $name) = @_;
-
- return $self->_deleteRecord ('system', "name='$name'");
-} # delete
-
-sub update ($%) {
- my ($self, $name, %update) = @_;
-
- return $self->_updateRecord ('system', "name='$name'", %update);
-} # update
-
-sub get ($) {
- my ($self, $system) = @_;
-
- return unless $system;
-
- my @records = $self->_getRecords (
- 'system',
- "name='$system' or alias like '%$system%'"
- );
-
- if ($records[0]) {
- return %{$records[0]};
- } else {
- return;
- } # if
-} # get
-
-sub find (;$) {
- my ($self, $condition) = @_;
-
- return $self->_getRecords ('system', $condition);
-} # find
-
-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
+\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
projects / clearscm.git / blobdiff