3 =head1 NAME $RCSfile: Clearadm.pm,v $
5 Object oriented interface to Clearadm.
13 Andrew DeFaria <Andrew@ClearSCM.com>
21 Tue Dec 07 09:13:27 EST 2010
25 $Date: 2012/11/09 06:43:26 $
31 Provides the Clearadm object which handles all interaction with the Clearadm
32 database. Similar add/change/delete/update methods for other record types. In
33 general you must orient your record hashs to have the appropriately named
34 keys that correspond to the database. Also see mothod documentation for
35 specifics about the method you are envoking.
37 # Create new Clearadm object
38 my $clearadm = new Clearadm;
43 alias => 'defaria.com',
44 admin => 'Andrew DeFaria',
45 os => 'Linux defaria.com 2.6.32-25-generic-pae #45-Ubuntu SMP Sat Oct 16 21:01:33 UTC 2010 i686 GNU/Linux',
47 description => 'Home server',
50 my ($err, $msg) = $clearadm->AddSystem (%system);
52 # Find systems matching 'jup'
53 my @systems = $clearadm->FindSystem ('jup');
55 # Get a system by name
56 my %system = $clearadm->GetSystem ('jupiter');
60 'region' => 'East Coast',
63 my ($err, $msg) = $clearadm->UpdateSystem ('jupiter', %update);
65 # Delete system (Warning: will delete all related records regarding this
67 my ($err, $msg) = $clearadm->DeleteSystem ('jupiter');
71 This package provides and object oriented interface to the Clearadm database.
72 Methods are provided to manipulate records by adding, updating and deleting
73 them. In general you need to specify a hash which contains keys and values
74 corresponding to the database field names and values.
78 The following methods are available:
90 use Net::Domain qw(hostdomain);
94 use lib "$FindBin::Bin", "$FindBin::Bin/../../lib";
101 my $conf = dirname (__FILE__) . '/../etc/clearadm.conf';
103 our %CLEAROPTS = GetConfig ($conf);
106 our $VERSION = '$Revision: 1.54 $';
107 ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
109 $CLEAROPTS{CLEARADM_USERNAME} = $ENV{CLEARADM_USERNAME}
110 ? $ENV{CLEARADM_USERNAME}
111 : $CLEAROPTS{CLEARADM_USERNAME}
112 ? $CLEAROPTS{CLEARADM_USERNAME}
114 $CLEAROPTS{CLEARADM_PASSWORD} = $ENV{CLEARADM_PASSWORD}
115 ? $ENV{CLEARADM_PASSWORD}
116 : $CLEAROPTS{CLEARADM_PASSWORD}
117 ? $CLEAROPTS{CLEARADM_PASSWORD}
119 $CLEAROPTS{CLEARADM_SERVER} = $ENV{CLEARADM_SERVER}
120 ? $ENV{CLEARADM_SERVER}
121 : $CLEAROPTS{CLEARADM_SERVER}
122 ? $CLEAROPTS{CLEARADM_SERVER}
125 my $defaultFilesystemThreshold = 90;
126 my $defaultFilesystemHist = '6 months';
127 my $defaultLoadavgHist = '6 months';
131 my ($self, $msg, $statement) = @_;
133 my $dberr = $self->{db}->err;
134 my $dberrmsg = $self->{db}->errstr;
137 $dberrmsg ||= 'Success';
142 my $function = (caller (1)) [3];
144 $message = "$function: $msg\nError #$dberr: $dberrmsg\n"
145 . "SQL Statement: $statement";
148 return $dberr, $message;
151 sub _formatValues (@) {
152 my ($self, @values) = @_;
157 push @returnValues, $_ eq '' ? 'null' : $self->{db}->quote ($_)
160 return @returnValues;
163 sub _formatNameValues (%) {
164 my ($self, %rec) = @_;
168 push @nameValueStrs, "$_=" . $self->{db}->quote ($rec{$_})
171 return @nameValueStrs;
172 } # _formatNameValues
174 sub _addRecord ($%) {
175 my ($self, $table, %rec) = @_;
177 my $statement = "insert into $table (";
178 $statement .= join ',', keys %rec;
179 $statement .= ') values (';
180 $statement .= join ',', $self->_formatValues (values %rec);
185 $self->{db}->do ($statement);
187 return $self->_dberror ("Unable to add record to $table", $statement);
190 sub _deleteRecord ($;$) {
191 my ($self, $table, $condition) = @_;
195 my $statement = "select count(*) from $table ";
196 $statement .= "where $condition"
199 my $sth = $self->{db}->prepare ($statement)
200 or return $self->_dberror ('Unable to prepare statement', $statement);
203 or return $self->_dberror ('Unable to execute statement', $statement);
205 my @row = $sth->fetchrow_array;
215 return ($count, 'Records deleted')
218 $statement = "delete from $table ";
219 $statement .= "where $condition"
222 $self->{db}->do ($statement);
224 if ($self->{db}->err) {
225 return $self->_dberror ("Unable to delete record from $table", $statement);
227 return $count, 'Records deleted';
231 sub _updateRecord ($$%) {
232 my ($self, $table, $condition, %rec) = @_;
234 my $statement = "update $table set ";
235 $statement .= join ',', $self->_formatNameValues (%rec);
236 $statement .= " where $condition"
239 $self->{db}->do ($statement);
241 return $self->_dberror ("Unable to update record in $table", $statement);
244 sub _checkRequiredFields ($$) {
245 my ($fields, $rec) = @_;
247 foreach my $fieldname (@$fields) {
250 foreach (keys %$rec) {
251 if ($fieldname eq $_) {
257 return "$fieldname is required"
262 } # _checkRequiredFields
264 sub _getRecords ($$) {
265 my ($self, $table, $condition) = @_;
269 my $statement = "select * from $table where $condition";
271 my $sth = $self->{db}->prepare ($statement);
274 ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
284 # We've been having the server going away. Supposedly it should reconnect so
285 # here we simply retry up to $maxAttempts times to re-execute the statement.
286 # (Are there other places where we need to do this?)
289 while ($err == 2006 and $attempts++ < $maxAttempts) {
290 $status = $sth->execute;
296 ($err, $msg) = $self->_dberror ('Unable to execute statement',
302 croak $msg unless $err == 2006;
304 my $timestamp = YMDHMS;
306 $self->Error ("$timestamp: Unable to talk to DB server.\n\n$msg\n\n"
307 . "Will try again in $sleepTime seconds", -1);
310 $self->_connect ($self->{dbserver});
315 $self->Error ("After $maxAttempts attempts I could not connect to the database", $err)
316 if ($err == 2006 and $attempts > $maxAttempts);
320 while (my $row = $sth->fetchrow_hashref) {
327 sub _aliasSystem ($) {
328 my ($self, $system) = @_;
330 my %system = $self->GetSystem ($system);
333 return $system{name};
342 my $statement = 'select last_insert_id()';
344 my $sth = $self->{db}->prepare ($statement);
349 ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
354 my $status = $sth->execute;
357 ($err, $msg) = $self->_dberror ('Unable to execute statement', $statement);
364 my @row = $sth->fetchrow_array;
370 my ($self, $dbserver) = @_;
372 $dbserver ||= $CLEAROPTS{CLEARADM_SERVER};
374 my $dbname = 'clearadm';
375 my $dbdriver = 'mysql';
377 $self->{db} = DBI->connect (
378 "DBI:$dbdriver:$dbname:$dbserver",
379 $CLEAROPTS{CLEARADM_USERNAME},
380 $CLEAROPTS{CLEARADM_PASSWORD},
383 "Couldn't connect to $dbname database "
384 . "as $CLEAROPTS{CLEARADM_USERNAME}\@$CLEAROPTS{CLEARADM_SERVER}"
387 $self->{dbserver} = $dbserver;
393 my ($class, $dbserver) = @_;
395 my $self = bless {}, $class;
397 $self->_connect ($dbserver);
405 $self->{NOTIFY} = $CLEAROPTS{CLEARADM_NOTIFY};
411 my ($self, $msg, $errno) = @_;
413 # If $errno is specified we need to stop. However we need to notify somebody
414 # that cleartasks is no longer running.
418 if ($self->{NOTIFY}) {
420 to => $self->{NOTIFY},
421 subject => 'Internal error occurred in Clearadm',
422 data => "<p>An unexpected, internal error occurred in Clearadm:</p><p>$msg</p>",
426 exit $errno if $errno > 0;
434 my ($self, %system) = @_;
436 my @requiredFields = (
440 my $result = _checkRequiredFields \@requiredFields, \%system;
442 return -1, "AddSystem: $result"
445 $system{loadavgHist} ||= $defaultLoadavgHist;
447 return $self->_addRecord ('system', %system);
450 sub DeleteSystem ($) {
451 my ($self, $name) = @_;
453 return $self->_deleteRecord ('system', "name='$name'");
456 sub UpdateSystem ($%) {
457 my ($self, $name, %update) = @_;
459 return $self->_updateRecord ('system', "name='$name'", %update);
463 my ($self, $system) = @_;
468 my @records = $self->_getRecords (
470 "name='$system' or alias like '%$system%'"
474 return %{$records[0]};
480 sub FindSystem (;$) {
481 my ($self, $system) = @_;
485 my $condition = "name like '%$system%' or alias like '%$system%'";
487 return $self->_getRecords ('system', $condition);
490 sub SearchSystem (;$) {
\r
491 my ($self, $condition) = @_;
493 $condition = "name like '%'" unless $condition;
495 return $self->_getRecords ('system', $condition);
\r
499 my ($self, %package) = @_;
501 my @requiredFields = (
507 my $result = _checkRequiredFields \@requiredFields, \%package;
509 return -1, "AddPackage: $result"
512 return $self->_addRecord ('package', %package);
515 sub DeletePackage ($$) {
516 my ($self, $system, $name) = @_;
518 return $self->_deleteRecord (
520 "(system='$system' or alias='$system') and name='$name'");
523 sub UpdatePackage ($$%) {
524 my ($self, $system, $name, %update) = @_;
526 $system = $self->_aliasSystem ($system);
531 return $self->_updateRecord ('package', "system='$system'", %update);
535 my ($self, $system, $name) = @_;
537 $system = $self->_aliasSystem ($system);
545 my @records = $self->_getRecords (
547 "system='$system' and name='$name'"
551 return %{$records[0]};
557 sub FindPackage ($;$) {
558 my ($self, $system, $name) = @_;
562 $system = $self->_aliasSystem ($system);
567 my $condition = "system='$system' and name like '%$name%'";
569 return $self->_getRecords ('package', $condition);
572 sub AddFilesystem (%) {
573 my ($self, %filesystem) = @_;
575 my @requiredFields = (
581 my $result = _checkRequiredFields \@requiredFields, \%filesystem;
583 return -1, "AddFilesystem: $result"
586 # Default filesystem threshold
587 $filesystem{threshold} ||= $defaultFilesystemThreshold;
589 return $self->_addRecord ('filesystem', %filesystem);
592 sub DeleteFilesystem ($$) {
593 my ($self, $system, $filesystem) = @_;
595 $system = $self->_aliasSystem ($system);
600 return $self->_deleteRecord (
602 "system='$system' and filesystem='$filesystem'"
606 sub UpdateFilesystem ($$%) {
607 my ($self, $system, $filesystem, %update) = @_;
609 $system = $self->_aliasSystem ($system);
614 return $self->_updateRecord (
616 "system='$system' and filesystem='$filesystem'",
621 sub GetFilesystem ($$) {
622 my ($self, $system, $filesystem) = @_;
624 $system = $self->_aliasSystem ($system);
632 my @records = $self->_getRecords (
634 "system='$system' and filesystem='$filesystem'"
638 return %{$records[0]};
644 sub FindFilesystem ($;$) {
645 my ($self, $system, $filesystem) = @_;
649 $system = $self->_aliasSystem ($system);
654 my $condition = "system='$system' and filesystem like '%$filesystem%'";
656 return $self->_getRecords ('filesystem', $condition);
660 my ($self, %vob) = @_;
662 my @requiredFields = (
667 my $result = _checkRequiredFields \@requiredFields, \%vob;
669 return -1, "AddVob: $result"
672 return $self->_addRecord ('vob', %vob);
676 my ($self, $tag) = @_;
678 return $self->_deleteRecord ('vob', "tag='$tag'");
682 my ($self, $tag) = @_;
687 my @records = $self->_getRecords ('vob', "tag='$tag'");
690 return %{$records[0]};
697 my ($self, $tag) = @_;
699 return $self->_getRecords ('vob', "tag like '%$tag%'");
703 my ($self, %view) = @_;
705 my @requiredFields = (
710 my $result = _checkRequiredFields \@requiredFields, \%view;
712 return -1, "AddView: $result"
715 return $self->_addRecord ('view', %view);
719 my ($self, $tag) = @_;
721 return $self->_deleteRecord ('vob', "tag='$tag'");
725 my ($self, $tag) = @_;
730 my @records = $self->_getRecords ('view', "tag='$tag'");
733 return %{$records[0]};
739 sub FindView (;$$$$) {
740 my ($self, $system, $region, $tag, $ownerName) = @_;
749 $condition = "system like '%$system%'";
750 $condition .= ' and ';
751 $condition = "region like '%$region%'";
752 $condition .= ' and ';
753 $condition .= "tag like '%$tag'";
754 $condition .= ' and ';
755 $condition .= "ownerName like '%$ownerName'";
757 return $self->_getRecords ('view', $condition);
761 my ($self, %fs) = @_;
763 my @requiredFields = (
768 my $result = _checkRequiredFields \@requiredFields, \%fs;
770 return -1, "AddFS: $result"
774 $fs{timestamp} = Today2SQLDatetime;
776 return $self->_addRecord ('fs', %fs);
780 my ($self, $system, $filesystem) = @_;
782 my %filesystem = $self->GetFilesystem ($system, $filesystem);
787 my %task = $self->GetTask ('scrub');
789 $self->Error ("Unable to find scrub task!", 1) unless %task;
792 my $today = Today2SQLDatetime;
794 # TODO: SubtractDays uses just an approximation (i.e. subtracting 30 days when
795 # in February is not right.
796 if ($filesystem{filesystemHist} =~ /(\d+) month/i) {
798 } elsif ($filesystem{filesystemHist} =~ /(\d+) year/i) {
802 my $oldage = SubtractDays $today, $days;
804 my ($dberr, $dbmsg) = $self->_deleteRecord (
806 "system='$system' and filesystem='$filesystem' and timestamp<='$oldage'"
809 if ($dbmsg eq 'Records deleted') {
815 $runlog{task} = $task{name};
816 $runlog{started} = $today;
819 "Scrubbed $dberr fs records for filesystem $system:$filesystem";
821 my ($err, $msg) = $self->AddRunlog (%runlog);
823 $self->Error ("Unable to add runlog - (Error: $err)\n$msg") if $err;
826 return ($dberr, $dbmsg);
829 sub TrimLoadavg ($) {
830 my ($self, $system) = @_;
832 my %system = $self->GetSystem ($system);
837 my %task = $self->GetTask ('loadavg');
839 $self->Error ("Unable to find loadavg task!", 1) unless %task;
842 my $today = Today2SQLDatetime;
844 # TODO: SubtractDays uses just an approximation (i.e. subtracting 30 days when
845 # in February is not right.
846 if ($system{loadavgHist} =~ /(\d+) month/i) {
848 } elsif ($system{loadavgHist} =~ /(\d+) year/i) {
852 my $oldage = SubtractDays $today, $days;
854 my ($dberr, $dbmsg) = $self->_deleteRecord (
856 "system='$system' and timestamp<='$oldage'"
859 if ($dbmsg eq 'Records deleted') {
865 $runlog{task} = $task{name};
866 $runlog{started} = $today;
869 "Scrubbed $dberr loadavg records for system $system";
871 my ($err, $msg) = $self->AddRunlog (%runlog);
873 $self->Error ("Unable to add runload (Error: $err)\n$msg") if $err;
876 return ($dberr, $dbmsg);
879 sub GetFS ($$;$$$$) {
880 my ($self, $system, $filesystem, $start, $end, $count, $interval) = @_;
882 $system = $self->_aliasSystem ($system);
890 $interval ||= 'Minute';
892 my $size = $interval =~ /month/i
894 : $interval =~ /day/i
896 : $interval =~ /hour/i
900 undef $start if $start and $start =~ /earliest/i;
901 undef $end if $end and $end =~ /latest/i;
903 my $condition = "system='$system' and filesystem='$filesystem'";
904 $condition .= " and timestamp>='$start'" if $start;
905 $condition .= " and timestamp<='$end'" if $end;
907 $condition .= " group by left(timestamp,$size)";
910 # We can't simply do a "limit 0, $count" as that just gets the front end of
911 # the records return (i.e. if $count = say 10 and the timestamp range
912 # returns 40 rows we'll see only rows 1-10, not rows 31-40). We need limit
913 # $offset, $count where $offset = the number of qualifying records minus
915 my $nbrRecs = $self->Count ('fs', $condition);
916 my $offset = $nbrRecs - $count;
918 # Offsets of < 0 are not allowed.
922 $condition .= " limit $offset, $count";
925 my $statement = <<"END";
930 left(timestamp,$size) as timestamp,
942 my $sth = $self->{db}->prepare ($statement);
945 ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
950 my $status = $sth->execute;
953 ($err, $msg) = $self->_dberror ('Unable to execute statement', $statement);
960 while (my $row = $sth->fetchrow_hashref) {
967 sub GetLatestFS ($$) {
968 my ($self, $system, $filesystem) = @_;
970 $system = $self->_aliasSystem ($system);
978 my @records = $self->_getRecords (
980 "system='$system' and filesystem='$filesystem'"
981 . " order by timestamp desc limit 0, 1",
985 return %{$records[0]};
992 my ($self, %loadavg) = @_;
994 my @requiredFields = (
998 my $result = _checkRequiredFields \@requiredFields, \%loadavg;
1000 return -1, "AddLoadavg: $result"
1004 $loadavg{timestamp} = Today2SQLDatetime;
1006 return $self->_addRecord ('loadavg', %loadavg);
1009 sub GetLoadavg ($;$$$$) {
1010 my ($self, $system, $start, $end, $count, $interval) = @_;
1012 $system = $self->_aliasSystem ($system);
1017 $interval ||= 'Minute';
1019 my $size = $interval =~ /month/i
1021 : $interval =~ /day/i
1023 : $interval =~ /hour/i
1029 undef $start if $start and $start =~ /earliest/i;
1030 undef $end if $end and $end =~ /latest/i;
1032 $condition .= " system='$system'" if $system;
1033 $condition .= " and timestamp>='$start'" if $start;
1034 $condition .= " and timestamp<='$end'" if $end;
1036 $condition .= " group by left(timestamp,$size)";
1039 # We can't simply do a "limit 0, $count" as that just gets the front end of
1040 # the records return (i.e. if $count = say 10 and the timestamp range
1041 # returns 40 rows we'll see only rows 1-10, not rows 31-40). We need limit
1042 # $offset, $count where $offset = the number of qualifying records minus
1044 my $nbrRecs = $self->Count ('loadavg', $condition);
1045 my $offset = $nbrRecs - $count;
1047 # Offsets of < 0 are not allowed.
1051 $condition .= " limit $offset, $count";
1054 my $statement = <<"END";
1057 left(timestamp,$size) as timestamp,
1060 avg(loadavg) as loadavg
1068 my $sth = $self->{db}->prepare ($statement);
1071 ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
1076 my $status = $sth->execute;
1079 ($err, $msg) = $self->_dberror ('Unable to execute statement', $statement);
1086 while (my $row = $sth->fetchrow_hashref) {
1087 push @records, $row;
1093 sub GetLatestLoadavg ($) {
1094 my ($self, $system) = @_;
1096 $system = $self->_aliasSystem ($system);
1101 my @records = $self->_getRecords (
1104 . " order by timestamp desc limit 0, 1",
1108 return %{$records[0]};
1112 } # GetLatestLoadavg
1115 my ($self, %task) = @_;
1117 my @requiredFields = (
1122 my $result = _checkRequiredFields \@requiredFields, \%task;
1124 return -1, "AddTask: $result"
1127 return $self->_addRecord ('task', %task);
1130 sub DeleteTask ($) {
1131 my ($self, $name) = @_;
1133 return $self->_deleteRecord ('task', "name='$name'");
1137 my ($self, $name) = @_;
1141 my $condition = "name like '%$name%'";
1143 return $self->_getRecords ('task', $condition);
1147 my ($self, $name) = @_;
1152 my @records = $self->_getRecords ('task', "name='$name'");
1155 return %{$records[0]};
1161 sub UpdateTask ($%) {
1162 my ($self, $name, %update) = @_;
1164 return $self->_updateRecord ('task', "name='$name'", %update);
1167 sub AddSchedule (%) {
1168 my ($self, %schedule) = @_;
1170 my @requiredFields = (
1174 my $result = _checkRequiredFields \@requiredFields, \%schedule;
1176 return -1, "AddSchedule: $result"
1179 return $self->_addRecord ('schedule', %schedule);
1182 sub DeleteSchedule ($) {
1183 my ($self, $name) = @_;
1185 return $self->_deleteRecord ('schedule', "name='$name'");
1188 sub FindSchedule (;$$) {
1189 my ($self, $name, $task) = @_;
1194 my $condition = "name like '%$name%'";
1195 $condition .= ' and ';
1196 $condition .= "task like '%$task%'";
1198 return $self->_getRecords ('schedule', $condition);
1201 sub GetSchedule ($) {
1202 my ($self, $name) = @_;
1204 my @records = $self->_getRecords ('schedule', "name='$name'");
1207 return %{$records[0]};
1213 sub UpdateSchedule ($%) {
1214 my ($self, $name, %update) = @_;
1216 return $self->_updateRecord ('schedule', "name='$name'", %update);
1220 my ($self, %runlog) = @_;
1222 my @requiredFields = (
1226 my $result = _checkRequiredFields \@requiredFields, \%runlog;
1228 return -1, "AddRunlog: $result"
1231 $runlog{ended} = Today2SQLDatetime;
1233 my ($err, $msg) = $self->_addRecord ('runlog', %runlog);
1235 return ($err, $msg, $self->_getLastID);
1238 sub DeleteRunlog ($) {
1239 my ($self, $condition) = @_;
1241 return $self->_deleteRecord ('runlog', $condition);
1244 sub FindRunlog (;$$$$$$) {
1245 my ($self, $task, $system, $status, $id, $start, $page) = @_;
1249 # If ID is specified then that's all that really matters as it uniquely
1250 # identifies a runlog entry;
1254 $condition = "task like '%$task%'";
1257 $condition .= " and system like '%$system%'"
1258 unless $system eq 'All';
1260 $condition .= ' and system is null';
1263 if (defined $status) {
1264 if ($status =~ /!(-*\d+)/) {
1265 $condition .= " and status<>$1";
1267 $condition .= " and status=$status"
1271 $condition .= " order by started desc";
1273 if (defined $start) {
1275 $condition .= " limit $start, $page";
1278 $condition = "id=$id";
1281 return $self->_getRecords ('runlog', $condition);
1285 my ($self, $id) = @_;
1290 my @records = $self->_getRecords ('runlog', "id=$id");
1293 return %{$records[0]};
1299 sub UpdateRunlog ($%) {
1300 my ($self, $id, %update) = @_;
1302 return $self->_updateRecord ('runlog', "id=$id", %update);
1306 my ($self, $table, $condition) = @_;
1308 $condition = $condition ? 'where ' . $condition : '';
1312 my $statement = "select count(*) from $table $condition";
1314 my $sth = $self->{db}->prepare ($statement);
1317 ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
1322 my $status = $sth->execute;
1325 ($err, $msg) = $self->_dberror ('Unable to execute statement', $statement);
1330 # Hack! Statements such as the following:
1332 # select count(*) from fs where system='jupiter' and filesystem='/dev/sdb5'
1333 # > group by left(timestamp,10);
1345 # 7 rows in set (0.00 sec)
1347 # Here we want 7 but what we see in $records[0] is 49. So the hack is that if
1348 # statement contains "group by" then we assume we have the above and return
1349 # scalar @records, otherwise we return $records[0];
1350 if ($statement =~ /group by/i) {
1351 my $allrows = $sth->fetchall_arrayref;
1353 return scalar @{$allrows};
1355 my @records = $sth->fetchrow_array;
1361 # GetWork returns two items, the number of seconds to wait before the next task
1362 # and array of hash records of work to be done immediately. The caller should
1363 # execute the work to be done, timing it, and subtracting it from the $sleep
1364 # time returned. If the caller exhausts the $sleep time then they should call
1371 my $statement = <<"END";
1373 schedule.name as schedulename,
1375 task.system as system,
1377 schedule.notification,
1379 runlog.started as lastrun
1382 schedule left join runlog on schedule.lastrunid=runlog.id
1384 schedule.task=task.name
1385 and schedule.active='true'
1389 my $sth = $self->{db}->prepare ($statement);
1392 ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
1397 my $status = $sth->execute;
1400 ($err, $msg) = $self->_dberror ('Unable to execute statement', $statement);
1408 while (my $row = $sth->fetchrow_hashref) {
1409 if ($$row{system} !~ /localhost/i) {
1410 my %system = $self->GetSystem ($$row{system});
1412 # Skip inactive systems
1413 next if $system{active} eq 'false';
1416 # If started is not defined then this task was never run so run it now.
1417 unless ($$row{lastrun}) {
1418 push @records, $row;
1422 # TODO: Handle frequencies better.
1425 if ($$row{frequency} =~ /(\d+) seconds/i) {
1427 } elsif ($$row{frequency} =~ /(\d+) minute/i) {
1429 } elsif ($$row{frequency} =~ /(\d+) hour/i) {
1430 $seconds = $1 * 60 * 60;
1431 } elsif ($$row{frequency} =~ /(\d+) day/i) {
1432 $seconds= $1 * 60 * 60 * 24;
1434 warning "Don't know how to handle frequencies like $$row{frequency}";
1438 my $today = Today2SQLDatetime;
1439 my $lastrun = Add ($$row{lastrun}, (seconds => $seconds));
1440 my $waitTime = DateToEpoch ($lastrun) - DateToEpoch ($today);
1442 if ($waitTime < 0) {
1443 # We're late - push this onto records and move on
1444 push @records, $row;
1447 $sleep ||= $waitTime;
1449 if ($sleep > $waitTime) {
1454 # Even if there is nothing to do the caller should sleep a bit and come back
1455 # to us. So if it ends up there's nothing past due, and nothing upcoming, then
1456 # sleep for a minute and return here. Somebody may have added a new task next
1457 # time we're called.
1458 if (@records == 0 and not $sleep) {
1462 return ($sleep, @records);
1465 sub GetUniqueList ($$) {
1466 my ($self, $table, $field) = @_;
1470 my $statement = "select $field from $table group by $field";
1472 my $sth = $self->{db}->prepare ($statement);
1475 ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
1480 my $status = $sth->execute;
1483 ($err, $msg) = $self->_dberror ('Unable to execute statement', $statement);
1490 while (my @row = $sth->fetchrow_array) {
1492 push @values, $row[0];
1494 push @values, '<NULL>';
1502 my ($self, %alert) = @_;
1504 my @requiredFields = (
1509 my $result = _checkRequiredFields \@requiredFields, \%alert;
1511 return -1, "AddAlert: $result"
1514 return $self->_addRecord ('alert', %alert);
1517 sub DeleteAlert ($) {
1518 my ($self, $name) = @_;
1520 return $self->_deleteRecord ('alert', "name='$name'");
1523 sub FindAlert (;$) {
1524 my ($self, $alert) = @_;
1528 my $condition = "name like '%$alert%'";
1530 return $self->_getRecords ('alert', $condition);
1534 my ($self, $name) = @_;
1539 my @records = $self->_getRecords ('alert', "name='$name'");
1542 return %{$records[0]};
1548 sub SendAlert ($$$$$$$) {
1560 my $footing = '<hr><p style="text-align: center;">';
1561 $footing .= '<font color="#bbbbbb">';
1562 my $year = (localtime)[5] + 1900;
1563 $footing .= "<a href='$CLEAROPTS{CLEARADM_WEBBASE}'>Clearadm</a><br>";
1564 $footing .= "Copyright © $year, ClearSCM, Inc. - All rights reserved";
1566 my %alert = $self->GetAlert ($alert);
1568 if ($alert{type} eq 'email') {
1569 my $from = 'Clearadm@' . hostdomain;
1574 subject => "Clearadm Alert: $system: $subject",
1577 footing => $footing,
1580 $self->Error ("Don't know how to send $alert{type} alerts\n"
1581 . "Subject: $subject\n"
1582 . "Message: $message", 1);
1589 notification => $notification,
1590 runlog => $runlogID,
1591 timestamp => Today2SQLDatetime,
1592 message => $subject,
1595 return $self->AddAlertlog (%alertlog);
1598 sub GetLastAlert ($$) {
1599 my ($self, $notification, $system) = @_;
1601 my $statement = <<"END";
1608 notification='$notification'
1609 and system='$system'
1616 my $sth = $self->{db}->prepare ($statement)
1617 or return $self->_dberror ('Unable to prepare statement', $statement);
1620 or return $self->_dberror ('Unable to execute statement', $statement);
1622 my $alertlog= $sth->fetchrow_hashref;
1633 sub GetLastTaskFailure ($$) {
1634 my ($self, $task, $system) = @_;
1636 my $statement = <<"END";
1645 and system='$system'
1653 my $sth = $self->{db}->prepare ($statement)
1654 or return $self->_dberror ('Unable to prepare statement', $statement);
1657 or return $self->_dberror ('Unable to execute statement', $statement);
1659 my $runlog= $sth->fetchrow_hashref;
1663 if ($$runlog{ended}) {
1667 # If we didn't get any ended in the last call then there's nothing that
1668 # qualified. Still let's return a record (%runlog) that has a valid id so
1669 # that the caller can update that runlog with alerted = 'true'.
1670 $statement = <<"END";
1678 and system='$system'
1685 $sth = $self->{db}->prepare ($statement)
1686 or return $self->_dberror ('Unable to prepare statement', $statement);
1689 or return $self->_dberror ('Unable to execute statement', $statement);
1691 $runlog = $sth->fetchrow_hashref;
1700 } # GetLastTaskFailure
1702 sub Notify ($$$$$$) {
1714 $runlogID = $self->_getLastID
1719 # Update filesystem, if $filesystem was specified
1721 ($err, $msg) = $self->UpdateFilesystem (
1724 notification => $notification,
1728 $self->Error ("Unable to set notification for filesystem $system:$filesystem "
1729 . "(Status: $err)\n$msg", $err) if $err;
1733 ($err, $msg) = $self->UpdateSystem (
1735 notification => $notification,
1739 my %notification = $self->GetNotification ($notification);
1741 my %lastnotified = $self->GetLastAlert ($notification, $system);
1743 if (%lastnotified and $lastnotified{timestamp}) {
1744 my $today = Today2SQLDatetime;
1745 my $lastnotified = $lastnotified{timestamp};
1747 if ($notification{nomorethan} =~ /hour/i) {
1748 $lastnotified = Add ($lastnotified, (hours => 1));
1749 } elsif ($notification{nomorethan} =~ /day/i) {
1750 $lastnotified = Add ($lastnotified, (days => 1));
1751 } elsif ($notification{nomorethan} =~ /week/i) {
1752 $lastnotified = Add ($lastnotified, (days => 7));
1753 } elsif ($notification{nomorethan} =~ /month/i) {
1754 $lastnotified = Add ($lastnotified, (month => 1));
1757 # If you want to fake an alert in the debugger just change $diff accordingly
1758 my $diff = Compare ($today, $lastnotified);
1764 my $when = Today2SQLDatetime;
1765 my $nomorethan = lc $notification{nomorethan};
1766 my %alert = $self->GetAlert ($notification{alert});
1767 my $to = $alert{who};
1769 # If $to is null then this means to send the alert to the admin for the
1773 my %system = $self->GetSystem ($system);
1775 $to = $system{email};
1777 # If we don't know what system this error occurred on we'll have to notify
1778 # the "super user" defined as $self->{NOTIFY} (The receiver of last
1780 $to = $self->{NOTIFY};
1785 Error "To undefined";
1788 $message .= "<p>You will receive this alert no more than $nomorethan.</p>";
1790 ($err, $msg) = $self->SendAlert (
1791 $notification{alert},
1793 $notification{name},
1800 $self->Error ("Unable to send alert (Status: $err)\n$msg", $err) if $err;
1802 verbose "Sent alert to $to";
1804 # Update runlog to indicate we notified the user for this execution
1805 ($err, $msg) = $self->UpdateRunlog (
1811 $self->Error ("Unable to update runlog (Status: $err)\n$msg", $err) if $err;
1816 sub ClearNotifications ($$;$) {
1817 my ($self, $system, $filesystem) = @_;
1822 ($err, $msg) = $self->UpdateFilesystem (
1824 $filesystem, (notification => undef),
1827 error "Unable to clear notification for filesystem $system:$filesystem "
1828 . "(Status: $err)\n$msg", $err
1831 # Check to see any of this system's filesystems have notifications. If none
1832 # then it's save to say we've turned off the last notification for a
1833 # filesystem involved with this system and if $system{notification} was
1834 # 'Filesystem' then we can toggle off the notification on the system too
1835 my $filesystemsAlerted = 0;
1837 foreach ($self->FindFilesystem ($system)) {
1838 $filesystemsAlerted++
1839 if $$_{notification};
1842 my %system = $self->GetSystem ($system);
1847 if ($system{notification} and
1848 $system{notification} eq 'Filesystem' and
1849 $filesystemsAlerted == 0) {
1850 ($err, $msg) = $self->UpdateSystem ($system, (notification => undef));
1852 $self->Error ("Unable to clear notification for system $system "
1853 . "(Status: $err)\n$msg", $err) if $err;
1856 ($err, $msg) = $self->UpdateSystem ($system, (notification => undef));
1858 $self->Error ("Unable to clear notification for system $system "
1859 . "(Status: $err)\n$msg", $err) if $err;
1863 } # ClearNotifications
1865 sub SystemAlive (%) {
1866 my ($self, %system) = @_;
1868 # If we've never heard from this system then we will assume that the system
1869 # has not been set up to run clearagent and has never checked in. In any event
1870 # we cannot say the system died because we've never known it to be alive!
1872 unless $system{lastheardfrom};
1874 # If a system is not active (may have been temporarily been deactivated) then
1875 # we don't want to turn on the bells and whistles alerting people it's down.
1877 if $system{active} eq 'false';
1879 my $today = Today2SQLDatetime;
1880 my $lastheardfrom = $system{lastheardfrom};
1882 my $tenMinutes = 10 * 60;
1884 $lastheardfrom = Add ($lastheardfrom, (seconds => $tenMinutes));
1886 if (DateToEpoch ($lastheardfrom) < DateToEpoch ($today)) {
1887 $self->UpdateSystem (
1889 notification => 'Heartbeat'
1895 if ($system{notification}) {
1896 $self->UpdateSystem (
1898 notification => undef
1906 sub UpdateAlert ($%) {
1907 my ($self, $name, %update) = @_;
1909 return $self->_updateRecord (
1916 sub AddAlertlog (%) {
1917 my ($self, %alertlog) = @_;
1919 my @requiredFields = (
1924 my $result = _checkRequiredFields \@requiredFields, \%alertlog;
1926 return -1, "AddAlertlog: $result"
1930 $alertlog{timestamp} = Today2SQLDatetime;
1932 return $self->_addRecord ('alertlog', %alertlog);
1935 sub DeleteAlertlog ($) {
1936 my ($self, $condition) = @_;
1941 if ($condition =~ /all/i) {
1942 return $self->_deleteRecord ('alertlog');
1944 return $self->_deleteRecord ('alertlog', $condition);
1948 sub FindAlertlog (;$$$$$) {
1949 my ($self, $alert, $system, $notification, $start, $page) = @_;
1953 $notification ||= '';
1955 my $condition = "alert like '%$alert%'";
1956 $condition .= ' and ';
1957 $condition .= "system like '%$system%'";
1958 $condition .= ' and ';
1959 $condition .= "notification like '%$notification%'";
1960 $condition .= " order by timestamp desc";
1962 if (defined $start) {
1964 $condition .= " limit $start, $page";
1967 return $self->_getRecords ('alertlog', $condition);
1970 sub GetAlertlog ($) {
1971 my ($self, $alert) = @_;
1976 my @records = $self->_getRecords ('alertlog', "alert='$alert'");
1979 return %{$records[0]};
1985 sub UpdateAlertlog ($%) {
1986 my ($self, $alert, %update) = @_;
1988 return $self->_updateRecord (
1995 sub AddNotification (%) {
1996 my ($self, %notification) = @_;
1998 my @requiredFields = (
2004 my $result = _checkRequiredFields \@requiredFields, \%notification;
2006 return -1, "AddNotification: $result"
2009 return $self->_addRecord ('notification', %notification);
2012 sub DeleteNotification ($) {
2013 my ($self, $name) = @_;
2015 return $self->_deleteRecord ('notification', "name='$name'");
2018 sub FindNotification (;$$) {
2019 my ($self, $name, $cond, $ordering) = @_;
2023 my $condition = "name like '%$name%'";
2024 $condition .= " and $cond"
2027 return $self->_getRecords ('notification', $condition);
2028 } # FindNotification
2030 sub GetNotification ($) {
2031 my ($self, $name) = @_;
2036 my @records = $self->_getRecords ('notification', "name='$name'");
2039 return %{$records[0]};
2045 sub UpdateNotification ($%) {
2046 my ($self, $name, %update) = @_;
2048 return $self->_updateRecord (
2053 } # UpdateNotification
2059 =head1 CONFIGURATION AND ENVIRONMENT
2061 DEBUG: If set then $debug is set to this level.
2063 VERBOSE: If set then $verbose is set to this level.
2065 TRACE: If set then $trace is set to this level.
2077 L<Net::Domain|Net::Domain>
2079 =head2 ClearSCM Perl Modules
2093 <a href="http://clearscm.com/php/scm_man.php?file=lib/DateUtils.pm">DateUtils</a><br>
2094 <a href="http://clearscm.com/php/scm_man.php?file=lib/Display.pm">Display</a><br>
2095 <a href="http://clearscm.com/php/scm_man.php?file=lib/GetConfig.pm">GetConfig</a><br>
2096 <a href="http://clearscm.com/php/scm_man.php?file=lib/Mail.pm">Mail</a><br>
2101 =head1 BUGS AND LIMITATIONS
2103 There are no known bugs in this module
2105 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
2107 =head1 LICENSE AND COPYRIGHT
2109 Copyright (c) 2010, ClearSCM, Inc. All rights reserved.