X-Git-Url: https://defaria.com/gitweb/?a=blobdiff_plain;f=lib%2FMachines.pm;h=76c1dfbef5dcb244b4db23cfdd4652df8d0bf3b3;hb=a0afcac06485b33b487e5c573d30df98b229a3ce;hp=804b35a9ac8ca1db6f6fccb86bc8a0d2d4250e2e;hpb=020a4a5ea2be725b155cae3a2cadc9aba3911b9b;p=clearscm.git diff --git a/lib/Machines.pm b/lib/Machines.pm index 804b35a..76c1dfb 100644 --- a/lib/Machines.pm +++ b/lib/Machines.pm @@ -1,214 +1,357 @@ -=pod - -=head1 NAME $RCSfile: Machines.pm,v $ - -Abstraction of machines. - -=head1 VERSION - -=over - -=item Author - -Andrew DeFaria - -=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 () - -Construct a new Machines object. The following OO style arguments are -supported: - -Parameters: - -=for html
- -=over - -=item file: - -Name of an alternate file from which to read machine information. This -is intended as a quick alternative. - -=back - -=for html
- -Returns: - -=for html
- -=over - -=item Machines object - -=back - -=for html
- -=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
- -=over - -=item none - -=back - -=for html
- -Returns: - -=begin html - -
- -=end html - -=over - -=item Array of machine hash records - -=back - -=for html
- -=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 . - -=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) 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 + +=head1 NAME $RCSfile: Machines.pm,v $ + +Object oriented interface to list of managed machines + +=head1 VERSION + +=over + +=item Author: + +Andrew DeFaria + +=item Revision: + +$Revision: 1.0 $ + +=item Created: + +Thu, Jul 12, 2018 5:11:44 PM + +=item Modified: + +$Date: $ + +=back + +=head1 SYNOPSIS + +Perl module to specify a list of managed machines for rexec.pl + + $machines = Machines->new (filename => "/opt/clearscm/data/machines"); + + my @machines = $machines->all; + + my @linux_machines = $machines->select(condition => 'OS = "linux"'); + +=head1 DESCRIPTION + +Machines is an OO interface to a list of managed machines. By default it parses +a file that contains machine names and other identifying information. + +=head1 ROUTINES + +The following routines are exported: + +=cut + +package Machines; + +use strict; +use warnings; + +use base 'Exporter'; + +use Carp; + +sub _parseFile() { + my ($self) = @_; + + my %machines; + + # Simple parse for now + open my $machineFile, '<', $self->{filename} + or croak "Unable to open $self->{filename} - $!"; + + while (<$machineFile>) { + chomp; + + next if /^#/; # Skip comments + + my ($name, $model, $os, $ccver, $owner, $usage) = split /:/; + + my %machineInfo = ( + model => $model, + os => $os, + ccver => $ccver, + owner => $owner, + usage => $usage, + ); + + $machines{$name} = \%machineInfo; + } # while + + close $machineFile; + + return \%machines; +} # _parseFile + +sub new(;%){ + my ($class, %parms) = @_; + +=pod + +=head2 new () + +Construct a new Machines object. The following OO style arguments are +supported: + +Parameters: + +=for html
+ +=over + +=item filename: + +Filename to parse + +=item path: + +Path where file resides + +=back + +=for html
+ +Returns:: + +=for html
+ +=over + +=item Machines object + +=back + +=for html
+ +=cut + + $parms{filename} ||= 'machines'; + + if (! -r $parms{filename}) { + croak "Unable to read $parms{filename}"; + } # if + + my $self = bless { + filename => $parms{filename}, + }, $class; # bless + + # Parse file + $self->{machines} = $self->_parseFile; + + return $self; +} # new + +sub select(;$) { + my ($self, $condition) = @_; + +=pod + +=head3 select + +Return machines that qualify based on $condition + +Parameters: + +=for html
+ +=over + +=item $condition + +Condition to apply to machine list + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item Array of qualifying machines + +=back + +=for html
+ +=cut + + $condition //= ''; + + if ($condition) { + croak "Not supporting conditions yet"; + } else { + return %{$self->{machines}}; + } # if +} # select + +sub GetSystem($) { + my ($self, $systemName) = @_; + + return; +} # getSystem + +sub AddSystem(%) { + my ($self, %system) = @_; + + return; +} # addSystem + +sub ChangeSystem(%){ + my ($self, %system) = @_; + + return; +} # changeSystem + +sub DeleteSystem($) { + my ($self, $systemName) = @_; + + return; +} # deleteSystem + +sub DumpSystems(;$) { + my ($self, $filename) = @_; + + $filename ||= 'machines'; + + open my $file, '>', $filename + or croak "Unable to open $filename for writing - $!"; + + # Write header + print $file <<"END"; +################################################################################ +# +# File: $filename +# Description: Dump of machines for use with rexec.pl +# Author: Andrew\@DeFaria.com +# +################################################################################ +# Column 1 Machine name +# Column 2 Alias +# Column 3 Active +# Column 4 Admin name +# Column 5 Admin email +# Column 6 OS version +# Column 7 OS Type +# Column 8 Last heard from +# Column 9 Description +END + + # Write out machine info + my @fields = qw(name alias active admin email os type lastheardfrom description); + + for my $record ($self->select) { + my %machine = %$record; + + for (@fields) { + print $file "$machine{$_}|" + } # for + + print $file "\n"; + } # for + + close $file; + + return; +} # DumpSystems + +sub ReadSystemsFile(;$) { + my ($self, $filename) = @_; + + $filename ||= 'machines'; + + open my $file, '<', $filename + or croak "Unable to open $filename - $!"; + + my @systems; + + while (<$file>) { + chomp; + + next if /^#/; + + my ($name, $model, $osver, $ccver, $owner, $usage) = split ':'; + my %system = ( + name => $name, + model => $model, + ccver => $ccver, + admin => $owner, + os => $osver, + type => 'Unix', + description => $usage, + ); + + push @systems, \%system; + } # while + + close $file; + + return @systems; +} # ReadSystemsFile + +1; + +=pod + +=head2 CONFIGURATION AND ENVIRONMENT + +DEBUG: If set then $debug in this module is set. + +VERBOSE: If set then $verbose in this module is set. + +=head2 DEPENDENCIES + +=head3 Perl Modules + +L + +L + +=head3 ClearSCM Perl Modules + +=for html

DateUtils

+ +=for html

Display

+ +=for html

Mail

+ +=for html

OSDep

+ +=for html

Utils

+ +=head2 INCOMPATABILITIES + +None yet... + +=head2 BUGS AND LIMITATIONS + +There are no known bugs in this module. + +Please report problems to Andrew DeFaria . + +=head2 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) 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