lib/Machines.pm

   1 =pod\r
   2 \r
   3 =head1 NAME $RCSfile: Machines.pm,v $\r
   4 \r
   5 Object oriented interface to list of managed machines\r
   6 \r
   7 =head1 VERSION\r
   8 \r
   9 =over\r
  10 \r
  11 =item Author:\r
  12 \r
  13 Andrew DeFaria <Andrew@DeFaria.com>\r
  14 \r
  15 =item Revision:\r
  16 \r
  17 $Revision: 1.0 $\r
  18 \r
  19 =item Created:\r
  20 \r
  21 Thu, Jul 12, 2018  5:11:44 PM\r
  22 \r
  23 =item Modified:\r
  24 \r
  25 $Date: $\r
  26 \r
  27 =back\r
  28 \r
  29 =head1 SYNOPSIS\r
  30 \r
  31 Perl module to specify a list of managed machines for rexec.pl\r
  32 \r
  33   $machines = Machines->new (filename => "/opt/clearscm/data/machines");\r
  34 \r
  35   my @machines = $machines->all;\r
  36 \r
  37   my @linux_machines = $machines->select(condition => 'OS = "linux"');\r
  38 \r
  39 =head1 DESCRIPTION\r
  40 \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
  43 \r
  44 =head1 ROUTINES\r
  45 \r
  46 The following routines are exported:\r
  47 \r
  48 =cut\r
  49 \r
  50 package Machines;\r
  51 \r
  52 use strict;\r
  53 use warnings;\r
  54 \r
  55 use base 'Exporter';\r
  56 \r
  57 use Carp;\r
  58 \r
  59 sub _parseFile() {\r
  60   my ($self) = @_;\r
  61 \r
  62   my %machines;\r
  63 \r
  64   # Simple parse for now\r
  65   open my $machineFile, '<', $self->{filename}\r
  66     or croak "Unable to open $self->{filename} - $!";\r
  67 \r
  68   while (<$machineFile>) {\r
  69     chomp;\r
  70 \r
  71     next if /^#/; # Skip comments\r
  72 \r
  73     my ($name, $model, $os, $ccver, $owner, $usage) = split /:/;\r
  74 \r
  75     my %machineInfo = (\r
  76       model => $model,\r
  77       os    => $os,\r
  78       ccver => $ccver,\r
  79       owner => $owner,\r
  80       usage => $usage,\r
  81     );\r
  82 \r
  83     $machines{$name} = \%machineInfo;\r
  84   } # while\r
  85 \r
  86   close $machineFile;\r
  87 \r
  88   return \%machines;\r
  89 } # _parseFile\r
  90 \r
  91 sub new(;%){\r
  92   my ($class, %parms) = @_;\r
  93 \r
  94 =pod\r
  95 \r
  96 =head2 new (<parms>)\r
  97 \r
  98 Construct a new Machines object. The following OO style arguments are\r
  99 supported:\r
 100 \r
 101 Parameters:\r
 102 \r
 103 =for html <blockquote>\r
 104 \r
 105 =over\r
 106 \r
 107 =item filename:\r
 108 \r
 109 Filename to parse\r
 110 \r
 111 =item path:\r
 112 \r
 113 Path where file resides\r
 114 \r
 115 =back\r
 116 \r
 117 =for html </blockquote>\r
 118 \r
 119 Returns::\r
 120 \r
 121 =for html <blockquote>\r
 122 \r
 123 =over\r
 124 \r
 125 =item Machines object\r
 126 \r
 127 =back\r
 128 \r
 129 =for html </blockquote>\r
 130 \r
 131 =cut\r
 132 \r
 133   $parms{filename} ||= 'machines';\r
 134 \r
 135   if (! -r $parms{filename}) {\r
 136     croak "Unable to read $parms{filename}";\r
 137   } # if\r
 138 \r
 139   my $self = bless {\r
 140     filename => $parms{filename},\r
 141   }, $class; # bless\r
 142 \r
 143   # Parse file\r
 144   $self->{machines} = $self->_parseFile;\r
 145 \r
 146   return $self;\r
 147 } # new\r
 148 \r
 149 sub select(;$) {\r
 150   my ($self, $condition) = @_;\r
 151 \r
 152 =pod\r
 153 \r
 154 =head3 select\r
 155 \r
 156 Return machines that qualify based on $condition\r
 157 \r
 158 Parameters:\r
 159 \r
 160 =for html <blockquote>\r
 161 \r
 162 =over\r
 163 \r
 164 =item $condition\r
 165 \r
 166 Condition to apply to machine list\r
 167 \r
 168 =back\r
 169 \r
 170 =for html </blockquote>\r
 171 \r
 172 Returns:\r
 173 \r
 174 =for html <blockquote>\r
 175 \r
 176 =over\r
 177 \r
 178 =item Array of qualifying machines\r
 179 \r
 180 =back\r
 181 \r
 182 =for html </blockquote>\r
 183 \r
 184 =cut\r
 185 \r
 186   $condition //= '';\r
 187 \r
 188   if ($condition) {\r
 189         croak "Not supporting conditions yet";\r
 190   } else {\r
 191     return %{$self->{machines}};\r
 192   } # if\r
 193 } # select\r
 194 \r
 195 sub GetSystem($) {\r
 196   my ($self, $systemName) = @_;\r
 197 \r
 198   return;\r
 199 } # getSystem\r
 200 \r
 201 sub AddSystem(%) {\r
 202   my ($self, %system) = @_;\r
 203 \r
 204   return;\r
 205 } # addSystem\r
 206 \r
 207 sub ChangeSystem(%){\r
 208   my ($self, %system) = @_;\r
 209 \r
 210   return;\r
 211 } # changeSystem\r
 212 \r
 213 sub DeleteSystem($) {\r
 214   my ($self, $systemName) = @_;\r
 215 \r
 216   return;\r
 217 } # deleteSystem\r
 218 \r
 219 sub DumpSystems(;$) {\r
 220   my ($self, $filename) = @_;\r
 221 \r
 222   $filename ||= 'machines';\r
 223 \r
 224   open my $file, '>', $filename\r
 225     or croak "Unable to open $filename for writing - $!";\r
 226 \r
 227   # Write header\r
 228   print $file <<"END";\r
 229 ################################################################################\r
 230 #\r
 231 # File:         $filename\r
 232 # Description:  Dump of machines for use with rexec.pl\r
 233 # Author:       Andrew\@DeFaria.com\r
 234 #\r
 235 ################################################################################\r
 236 # Column 1 Machine name\r
 237 # Column 2 Alias\r
 238 # Column 3 Active\r
 239 # Column 4 Admin name\r
 240 # Column 5 Admin email\r
 241 # Column 6 OS version\r
 242 # Column 7 OS Type\r
 243 # Column 8 Last heard from\r
 244 # Column 9 Description\r
 245 END\r
 246 \r
 247   # Write out machine info\r
 248   my @fields = qw(name alias active admin email os type lastheardfrom description);\r
 249 \r
 250   for my $record ($self->select) {\r
 251     my %machine = %$record;\r
 252 \r
 253     for (@fields) {\r
 254       print $file "$machine{$_}|"\r
 255     } # for\r
 256 \r
 257     print $file "\n";\r
 258   } # for\r
 259 \r
 260   close $file;\r
 261 \r
 262   return;\r
 263 } # DumpSystems\r
 264 \r
 265 sub ReadSystemsFile(;$) {\r
 266   my ($self, $filename) = @_;\r
 267 \r
 268   $filename ||= 'machines';\r
 269 \r
 270   open my $file, '<', $filename\r
 271     or croak "Unable to open $filename - $!";\r
 272 \r
 273   my @systems;\r
 274 \r
 275   while (<$file>) {\r
 276     chomp;\r
 277 \r
 278     next if /^#/;\r
 279 \r
 280     my ($name, $model, $osver, $ccver, $owner, $usage) = split ':';\r
 281     my %system = (\r
 282       name        => $name,\r
 283       model       => $model,\r
 284       ccver       => $ccver,\r
 285       admin       => $owner,\r
 286       os          => $osver,\r
 287       type        => 'Unix',\r
 288       description => $usage,\r
 289     );\r
 290 \r
 291     push @systems, \%system;\r
 292   } # while\r
 293 \r
 294   close $file;\r
 295 \r
 296   return @systems;\r
 297 } # ReadSystemsFile\r
 298 \r
 299 1;\r
 300 \r
 301 =pod\r
 302 \r
 303 =head2 CONFIGURATION AND ENVIRONMENT\r
 304 \r
 305 DEBUG: If set then $debug in this module is set.\r
 306 \r
 307 VERBOSE: If set then $verbose in this module is set.\r
 308 \r
 309 =head2 DEPENDENCIES\r
 310 \r
 311 =head3 Perl Modules\r
 312 \r
 313 L<File::Spec>\r
 314 \r
 315 L<IO::Handle>\r
 316 \r
 317 =head3 ClearSCM Perl Modules\r
 318 \r
 319 =for html <p><a href="/php/scm_man.php?file=lib/DateUtils.pm">DateUtils</a></p>\r
 320 \r
 321 =for html <p><a href="/php/scm_man.php?file=lib/Display.pm">Display</a></p>\r
 322 \r
 323 =for html <p><a href="/php/scm_man.php?file=lib/Mail.pm">Mail</a></p>\r
 324 \r
 325 =for html <p><a href="/php/scm_man.php?file=lib/OSDep.pm">OSDep</a></p>\r
 326 \r
 327 =for html <p><a href="/php/scm_man.php?file=lib/Utils.pm">Utils</a></p>\r
 328 \r
 329 =head2 INCOMPATABILITIES\r
 330 \r
 331 None yet...\r
 332 \r
 333 =head2 BUGS AND LIMITATIONS\r
 334 \r
 335 There are no known bugs in this module.\r
 336 \r
 337 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.\r
 338 \r
 339 =head2 LICENSE AND COPYRIGHT\r
 340 \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
 345 \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
 350 details.\r
 351 \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
 355 reserved.\r
 356 \r
 357 =cut\r