3 =head1 NAME $RCSfile: Machines.pm,v $
5 Abstraction of machines.
13 Andrew DeFaria <Andrew@ClearSCM.com>
21 Tue Jan 8 17:24:16 MST 2008
25 $Date: 2011/11/16 19:46:13 $
31 This module handles the details of providing information about
32 machines while obscuring the mechanism for storing such information.
34 my $machines = Machines->new;
36 foreach ($machine->all) {
38 display "Machine: $machine{name}";
39 disp.ay "Owner: $machine{owner}"
44 This module provides information about machines
48 The following routines are exported:
65 our %MACHINESOPTS = GetConfig ("$FindBin::Bin/../etc/machines.conf");
67 my $defaultFilesystemThreshold = 90;
68 my $defaultFilesystemHist = '6 months';
69 my $defaultLoadavgHist = '6 months';
73 my ($self, $msg, $statement) = @_;
75 my $dberr = $self->{db}->err;
76 my $dberrmsg = $self->{db}->errstr;
79 $dberrmsg ||= 'Success';
84 my $function = (caller (1)) [3];
86 $message = "$function: $msg\nError #$dberr: $dberrmsg\n"
87 . "SQL Statement: $statement";
90 return $dberr, $message;
93 sub _formatValues (@) {
94 my ($self, @values) = @_;
99 push @returnValues, $_ eq '' ? 'null' : $self->{db}->quote ($_)
102 return @returnValues;
105 sub _formatNameValues (%) {
106 my ($self, %rec) = @_;
110 push @nameValueStrs, "$_=" . $self->{db}->quote ($rec{$_})
113 return @nameValueStrs;
114 } # _formatNameValues
120 if ($self->{errno}) {
128 sub _addRecord ($%) {
129 my ($self, $table, %rec) = @_;
131 my $statement = "insert into $table (";
132 $statement .= join ',', keys %rec;
133 $statement .= ') values (';
134 $statement .= join ',', $self->_formatValues (values %rec);
139 $self->{db}->do ($statement);
141 return $self->_dberror ("Unable to add record to $table", $statement);
144 sub _checkRequiredFields ($$) {
145 my ($fields, $rec) = @_;
147 foreach my $fieldname (@$fields) {
150 foreach (keys %$rec) {
151 if ($fieldname eq $_) {
157 return "$fieldname is required"
162 } # _checkRequiredFields
165 my ($self, $dbserver) = @_;
167 $dbserver ||= $MACHINESOPTS{MACHINES_SERVER};
169 my $dbname = 'machines';
170 my $dbdriver = 'mysql';
172 $self->{db} = DBI->connect (
173 "DBI:$dbdriver:$dbname:$dbserver",
174 $MACHINESOPTS{MACHINES_USERNAME},
175 $MACHINESOPTS{MACHINES_PASSWORD},
178 "Couldn't connect to $dbname database "
179 . "as $MACHINESOPTS{MACHINESADM_USERNAME}\@$MACHINESOPTS{MACHINESADM_SERVER}"
182 $self->{dbserver} = $dbserver;
187 sub _getRecords ($$) {
188 my ($self, $table, $condition) = @_;
192 my $statement = "select * from $table where $condition";
194 my $sth = $self->{db}->prepare ($statement);
197 ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
207 # We've been having the server going away. Supposedly it should reconnect so
208 # here we simply retry up to $maxAttempts times to re-execute the statement.
209 # (Are there other places where we need to do this?)
212 while ($err == 2006 and $attempts++ < $maxAttempts) {
213 $status = $sth->execute;
219 ($err, $msg) = $self->_dberror ('Unable to execute statement',
225 croak $msg unless $err == 2006;
227 my $timestamp = YMDHMS;
229 $self->Error ("$timestamp: Unable to talk to DB server.\n\n$msg\n\n"
230 . "Will try again in $sleepTime seconds", -1);
233 $self->_connect ($self->{dbserver});
238 $self->Error ("After $maxAttempts attempts I could not connect to the database", $err)
239 if ($err == 2006 and $attempts > $maxAttempts);
243 while (my $row = $sth->fetchrow_hashref) {
252 my ($class, %parms) = @_;
258 Construct a new Machines object.
262 # Merge %parms with %MACHINEOPTS
263 foreach (keys %parms) {
264 $MACHINESOPTS{$_} = $parms{$_};
267 my $self = bless {}, $class;
275 my ($self, %system) = @_;
277 my @requiredFields = qw(
283 my $result = _checkRequiredFields \@requiredFields, \%system;
285 return -1, "add: $result" if $result;
287 $system{loadavgHist} ||= $defaultLoadavgHist;
289 return $self->_addRecord ('system', %system);
293 my ($self, $name) = @_;
295 return $self->_deleteRecord ('system', "name='$name'");
299 my ($self, $name, %update) = @_;
301 return $self->_updateRecord ('system', "name='$name'", %update);
305 my ($self, $system) = @_;
307 return unless $system;
309 my @records = $self->_getRecords (
311 "name='$system' or alias like '%$system%'"
315 return %{$records[0]};
322 my ($self, $condition) = @_;
324 return $self->_getRecords ('system', $condition);
331 =head1 CONFIGURATION AND ENVIRONMENT
333 MACHINES: If set then points to a flat file containing machine
334 names. Note this is providied as a way to quickly use an alternate
335 "machine database". As such only minimal information is support.
342 =head1 INCOMPATABILITIES
346 =head1 BUGS AND LIMITATIONS
348 There are no known bugs in this module.
350 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
352 =head1 LICENSE AND COPYRIGHT
354 This Perl Module is freely available; you can redistribute it and/or
355 modify it under the terms of the GNU General Public License as
356 published by the Free Software Foundation; either version 2 of the
357 License, or (at your option) any later version.
359 This Perl Module is distributed in the hope that it will be useful,
360 but WITHOUT ANY WARRANTY; without even the implied warranty of
361 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
362 General Public License (L<http://www.gnu.org/copyleft/gpl.html>) for more
365 You should have received a copy of the GNU General Public License
366 along with this Perl Module; if not, write to the Free Software Foundation,
367 Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.