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:
89 use Net::Domain qw(hostdomain);
93 use lib "$FindBin::Bin", "$FindBin::Bin/../../lib";
100 our %CLEAROPTS = GetConfig ("$FindBin::Bin/etc/clearadm.conf");
103 our $VERSION = '$Revision: 1.54 $';
104 ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
106 $CLEAROPTS{CLEARADM_USERNAME} = $ENV{CLEARADM_USERNAME}
107 ? $ENV{CLEARADM_USERNAME}
108 : $CLEAROPTS{CLEARADM_USERNAME}
109 ? $CLEAROPTS{CLEARADM_USERNAME}
111 $CLEAROPTS{CLEARADM_PASSWORD} = $ENV{CLEARADM_PASSWORD}
112 ? $ENV{CLEARADM_PASSWORD}
113 : $CLEAROPTS{CLEARADM_PASSWORD}
114 ? $CLEAROPTS{CLEARADM_PASSWORD}
116 $CLEAROPTS{CLEARADM_SERVER} = $ENV{CLEARADM_SERVER}
117 ? $ENV{CLEARADM_SERVER}
118 : $CLEAROPTS{CLEARADM_SERVER}
119 ? $CLEAROPTS{CLEARADM_SERVER}
122 my $defaultFilesystemThreshold = 90;
123 my $defaultFilesystemHist = '6 months';
124 my $defaultLoadavgHist = '6 months';
128 my ($self, $msg, $statement) = @_;
130 my $dberr = $self->{db}->err;
131 my $dberrmsg = $self->{db}->errstr;
134 $dberrmsg ||= 'Success';
139 my $function = (caller (1)) [3];
141 $message = "$function: $msg\nError #$dberr: $dberrmsg\n"
142 . "SQL Statement: $statement";
145 return $dberr, $message;
148 sub _formatValues (@) {
149 my ($self, @values) = @_;
154 push @returnValues, $_ eq '' ? 'null' : $self->{db}->quote ($_)
157 return @returnValues;
160 sub _formatNameValues (%) {
161 my ($self, %rec) = @_;
165 push @nameValueStrs, "$_=" . $self->{db}->quote ($rec{$_})
168 return @nameValueStrs;
169 } # _formatNameValues
171 sub _addRecord ($%) {
172 my ($self, $table, %rec) = @_;
174 my $statement = "insert into $table (";
175 $statement .= join ',', keys %rec;
176 $statement .= ') values (';
177 $statement .= join ',', $self->_formatValues (values %rec);
182 $self->{db}->do ($statement);
184 return $self->_dberror ("Unable to add record to $table", $statement);
187 sub _deleteRecord ($;$) {
188 my ($self, $table, $condition) = @_;
192 my $statement = "select count(*) from $table ";
193 $statement .= "where $condition"
196 my $sth = $self->{db}->prepare ($statement)
197 or return $self->_dberror ('Unable to prepare statement', $statement);
200 or return $self->_dberror ('Unable to execute statement', $statement);
202 my @row = $sth->fetchrow_array;
212 return ($count, 'Records deleted')
215 $statement = "delete from $table ";
216 $statement .= "where $condition"
219 $self->{db}->do ($statement);
221 if ($self->{db}->err) {
222 return $self->_dberror ("Unable to delete record from $table", $statement);
224 return $count, 'Records deleted';
228 sub _updateRecord ($$%) {
229 my ($self, $table, $condition, %rec) = @_;
231 my $statement = "update $table set ";
232 $statement .= join ',', $self->_formatNameValues (%rec);
233 $statement .= " where $condition"
236 $self->{db}->do ($statement);
238 return $self->_dberror ("Unable to update record in $table", $statement);
241 sub _checkRequiredFields ($$) {
242 my ($fields, $rec) = @_;
244 foreach my $fieldname (@$fields) {
247 foreach (keys %$rec) {
248 if ($fieldname eq $_) {
254 return "$fieldname is required"
259 } # _checkRequiredFields
261 sub _getRecords ($$) {
262 my ($self, $table, $condition) = @_;
266 my $statement = "select * from $table where $condition";
268 my $sth = $self->{db}->prepare ($statement);
271 ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
281 # We've been having the server going away. Supposedly it should reconnect so
282 # here we simply retry up to $maxAttempts times to re-execute the statement.
283 # (Are there other places where we need to do this?)
286 while ($err == 2006 and $attempts++ < $maxAttempts) {
287 $status = $sth->execute;
293 ($err, $msg) = $self->_dberror ('Unable to execute statement',
299 croak $msg unless $err == 2006;
301 my $timestamp = YMDHMS;
303 $self->Error ("$timestamp: Unable to talk to DB server.\n\n$msg\n\n"
304 . "Will try again in $sleepTime seconds", -1);
307 $self->_connect ($self->{dbserver});
312 $self->Error ("After $maxAttempts attempts I could not connect to the database", $err)
313 if ($err == 2006 and $attempts > $maxAttempts);
317 while (my $row = $sth->fetchrow_hashref) {
324 sub _aliasSystem ($) {
325 my ($self, $system) = @_;
327 my %system = $self->GetSystem ($system);
330 return $system{name};
339 my $statement = 'select last_insert_id()';
341 my $sth = $self->{db}->prepare ($statement);
346 ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
351 my $status = $sth->execute;
354 ($err, $msg) = $self->_dberror ('Unable to execute statement', $statement);
361 my @row = $sth->fetchrow_array;
367 my ($self, $dbserver) = @_;
369 $dbserver ||= $CLEAROPTS{CLEARADM_SERVER};
371 my $dbname = 'clearadm';
372 my $dbdriver = 'mysql';
374 $self->{db} = DBI->connect (
375 "DBI:$dbdriver:$dbname:$dbserver",
376 $CLEAROPTS{CLEARADM_USERNAME},
377 $CLEAROPTS{CLEARADM_PASSWORD},
380 "Couldn't connect to $dbname database "
381 . "as $CLEAROPTS{CLEARADM_USERNAME}\@$CLEAROPTS{CLEARADM_SERVER}"
384 $self->{dbserver} = $dbserver;
390 my ($class, $dbserver) = @_;
392 my $self = bless {}, $class;
394 $self->_connect ($dbserver);
402 $self->{NOTIFY} = $CLEAROPTS{CLEARADM_NOTIFY};
408 my ($self, $msg, $errno) = @_;
410 # If $errno is specified we need to stop. However we need to notify somebody
411 # that cleartasks is no longer running.
415 if ($self->{NOTIFY}) {
417 to => $self->{NOTIFY},
418 subject => 'Internal error occurred in Clearadm',
419 data => "<p>An unexpected, internal error occurred in Clearadm:</p><p>$msg</p>",
423 exit $errno if $errno > 0;
431 my ($self, %system) = @_;
433 my @requiredFields = (
437 my $result = _checkRequiredFields \@requiredFields, \%system;
439 return -1, "AddSystem: $result"
442 $system{loadavgHist} ||= $defaultLoadavgHist;
444 return $self->_addRecord ('system', %system);
447 sub DeleteSystem ($) {
448 my ($self, $name) = @_;
450 return $self->_deleteRecord ('system', "name='$name'");
453 sub UpdateSystem ($%) {
454 my ($self, $name, %update) = @_;
456 return $self->_updateRecord ('system', "name='$name'", %update);
460 my ($self, $system) = @_;
465 my @records = $self->_getRecords (
467 "name='$system' or alias like '%$system%'"
471 return %{$records[0]};
477 sub FindSystem (;$) {
478 my ($self, $system) = @_;
482 my $condition = "name like '%$system%' or alias like '%$system%'";
484 return $self->_getRecords ('system', $condition);
488 my ($self, %package) = @_;
490 my @requiredFields = (
496 my $result = _checkRequiredFields \@requiredFields, \%package;
498 return -1, "AddPackage: $result"
501 return $self->_addRecord ('package', %package);
504 sub DeletePackage ($$) {
505 my ($self, $system, $name) = @_;
507 return $self->_deleteRecord (
509 "(system='$system' or alias='$system') and name='$name'");
512 sub UpdatePackage ($$%) {
513 my ($self, $system, $name, %update) = @_;
515 $system = $self->_aliasSystem ($system);
520 return $self->_updateRecord ('package', "system='$system'", %update);
524 my ($self, $system, $name) = @_;
526 $system = $self->_aliasSystem ($system);
534 my @records = $self->_getRecords (
536 "system='$system' and name='$name'"
540 return %{$records[0]};
546 sub FindPackage ($;$) {
547 my ($self, $system, $name) = @_;
551 $system = $self->_aliasSystem ($system);
556 my $condition = "system='$system' and name like '%$name%'";
558 return $self->_getRecords ('package', $condition);
561 sub AddFilesystem (%) {
562 my ($self, %filesystem) = @_;
564 my @requiredFields = (
570 my $result = _checkRequiredFields \@requiredFields, \%filesystem;
572 return -1, "AddFilesystem: $result"
575 # Default filesystem threshold
576 $filesystem{threshold} ||= $defaultFilesystemThreshold;
578 return $self->_addRecord ('filesystem', %filesystem);
581 sub DeleteFilesystem ($$) {
582 my ($self, $system, $filesystem) = @_;
584 $system = $self->_aliasSystem ($system);
589 return $self->_deleteRecord (
591 "system='$system' and filesystem='$filesystem'"
595 sub UpdateFilesystem ($$%) {
596 my ($self, $system, $filesystem, %update) = @_;
598 $system = $self->_aliasSystem ($system);
603 return $self->_updateRecord (
605 "system='$system' and filesystem='$filesystem'",
610 sub GetFilesystem ($$) {
611 my ($self, $system, $filesystem) = @_;
613 $system = $self->_aliasSystem ($system);
621 my @records = $self->_getRecords (
623 "system='$system' and filesystem='$filesystem'"
627 return %{$records[0]};
633 sub FindFilesystem ($;$) {
634 my ($self, $system, $filesystem) = @_;
638 $system = $self->_aliasSystem ($system);
643 my $condition = "system='$system' and filesystem like '%$filesystem%'";
645 return $self->_getRecords ('filesystem', $condition);
649 my ($self, %vob) = @_;
651 my @requiredFields = (
656 my $result = _checkRequiredFields \@requiredFields, \%vob;
658 return -1, "AddVob: $result"
661 return $self->_addRecord ('vob', %vob);
665 my ($self, $tag) = @_;
667 return $self->_deleteRecord ('vob', "tag='$tag'");
671 my ($self, $tag) = @_;
676 my @records = $self->_getRecords ('vob', "tag='$tag'");
679 return %{$records[0]};
686 my ($self, $tag) = @_;
688 return $self->_getRecords ('vob', "tag like '%$tag%'");
692 my ($self, %view) = @_;
694 my @requiredFields = (
699 my $result = _checkRequiredFields \@requiredFields, \%view;
701 return -1, "AddView: $result"
704 return $self->_addRecord ('view', %view);
708 my ($self, $tag) = @_;
710 return $self->_deleteRecord ('vob', "tag='$tag'");
714 my ($self, $tag) = @_;
719 my @records = $self->_getRecords ('view', "tag='$tag'");
722 return %{$records[0]};
728 sub FindView (;$$$$) {
729 my ($self, $system, $region, $tag, $ownerName) = @_;
738 $condition = "system like '%$system%'";
739 $condition .= ' and ';
740 $condition = "region like '%$region%'";
741 $condition .= ' and ';
742 $condition .= "tag like '%$tag'";
743 $condition .= ' and ';
744 $condition .= "ownerName like '%$ownerName'";
746 return $self->_getRecords ('view', $condition);
750 my ($self, %fs) = @_;
752 my @requiredFields = (
757 my $result = _checkRequiredFields \@requiredFields, \%fs;
759 return -1, "AddFS: $result"
763 $fs{timestamp} = Today2SQLDatetime;
765 return $self->_addRecord ('fs', %fs);
769 my ($self, $system, $filesystem) = @_;
771 my %filesystem = $self->GetFilesystem ($system, $filesystem);
776 my %task = $self->GetTask ('scrub');
778 $self->Error ("Unable to find scrub task!", 1) unless %task;
781 my $today = Today2SQLDatetime;
783 # TODO: SubtractDays uses just an approximation (i.e. subtracting 30 days when
784 # in February is not right.
785 if ($filesystem{filesystemHist} =~ /(\d+) month/i) {
787 } elsif ($filesystem{filesystemHist} =~ /(\d+) year/i) {
791 my $oldage = SubtractDays $today, $days;
793 my ($dberr, $dbmsg) = $self->_deleteRecord (
795 "system='$system' and filesystem='$filesystem' and timestamp<='$oldage'"
798 if ($dbmsg eq 'Records deleted') {
804 $runlog{task} = $task{name};
805 $runlog{started} = $today;
808 "Scrubbed $dberr fs records for filesystem $system:$filesystem";
810 my ($err, $msg) = $self->AddRunlog (%runlog);
812 $self->Error ("Unable to add runlog - (Error: $err)\n$msg") if $err;
815 return ($dberr, $dbmsg);
818 sub TrimLoadavg ($) {
819 my ($self, $system) = @_;
821 my %system = $self->GetSystem ($system);
826 my %task = $self->GetTask ('loadavg');
828 $self->Error ("Unable to find loadavg task!", 1) unless %task;
831 my $today = Today2SQLDatetime;
833 # TODO: SubtractDays uses just an approximation (i.e. subtracting 30 days when
834 # in February is not right.
835 if ($system{loadavgHist} =~ /(\d+) month/i) {
837 } elsif ($system{loadavgHist} =~ /(\d+) year/i) {
841 my $oldage = SubtractDays $today, $days;
843 my ($dberr, $dbmsg) = $self->_deleteRecord (
845 "system='$system' and timestamp<='$oldage'"
848 if ($dbmsg eq 'Records deleted') {
854 $runlog{task} = $task{name};
855 $runlog{started} = $today;
858 "Scrubbed $dberr loadavg records for system $system";
860 my ($err, $msg) = $self->AddRunlog (%runlog);
862 $self->Error ("Unable to add runload (Error: $err)\n$msg") if $err;
865 return ($dberr, $dbmsg);
868 sub GetFS ($$;$$$$) {
869 my ($self, $system, $filesystem, $start, $end, $count, $interval) = @_;
871 $system = $self->_aliasSystem ($system);
879 $interval ||= 'Minute';
881 my $size = $interval =~ /month/i
883 : $interval =~ /day/i
885 : $interval =~ /hour/i
889 undef $start if $start and $start =~ /earliest/i;
890 undef $end if $end and $end =~ /latest/i;
892 my $condition = "system='$system' and filesystem='$filesystem'";
893 $condition .= " and timestamp>='$start'" if $start;
894 $condition .= " and timestamp<='$end'" if $end;
896 $condition .= " group by left(timestamp,$size)";
899 # We can't simply do a "limit 0, $count" as that just gets the front end of
900 # the records return (i.e. if $count = say 10 and the timestamp range
901 # returns 40 rows we'll see only rows 1-10, not rows 31-40). We need limit
902 # $offset, $count where $offset = the number of qualifying records minus
904 my $nbrRecs = $self->Count ('fs', $condition);
905 my $offset = $nbrRecs - $count;
907 # Offsets of < 0 are not allowed.
911 $condition .= " limit $offset, $count";
914 my $statement = <<"END";
919 left(timestamp,$size) as timestamp,
931 my $sth = $self->{db}->prepare ($statement);
934 ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
939 my $status = $sth->execute;
942 ($err, $msg) = $self->_dberror ('Unable to execute statement', $statement);
949 while (my $row = $sth->fetchrow_hashref) {
956 sub GetLatestFS ($$) {
957 my ($self, $system, $filesystem) = @_;
959 $system = $self->_aliasSystem ($system);
967 my @records = $self->_getRecords (
969 "system='$system' and filesystem='$filesystem'"
970 . " order by timestamp desc limit 0, 1",
974 return %{$records[0]};
981 my ($self, %loadavg) = @_;
983 my @requiredFields = (
987 my $result = _checkRequiredFields \@requiredFields, \%loadavg;
989 return -1, "AddLoadavg: $result"
993 $loadavg{timestamp} = Today2SQLDatetime;
995 return $self->_addRecord ('loadavg', %loadavg);
998 sub GetLoadavg ($;$$$$) {
999 my ($self, $system, $start, $end, $count, $interval) = @_;
1001 $system = $self->_aliasSystem ($system);
1006 $interval ||= 'Minute';
1008 my $size = $interval =~ /month/i
1010 : $interval =~ /day/i
1012 : $interval =~ /hour/i
1018 undef $start if $start and $start =~ /earliest/i;
1019 undef $end if $end and $end =~ /latest/i;
1021 $condition .= " system='$system'" if $system;
1022 $condition .= " and timestamp>='$start'" if $start;
1023 $condition .= " and timestamp<='$end'" if $end;
1025 $condition .= " group by left(timestamp,$size)";
1028 # We can't simply do a "limit 0, $count" as that just gets the front end of
1029 # the records return (i.e. if $count = say 10 and the timestamp range
1030 # returns 40 rows we'll see only rows 1-10, not rows 31-40). We need limit
1031 # $offset, $count where $offset = the number of qualifying records minus
1033 my $nbrRecs = $self->Count ('loadavg', $condition);
1034 my $offset = $nbrRecs - $count;
1036 # Offsets of < 0 are not allowed.
1040 $condition .= " limit $offset, $count";
1043 my $statement = <<"END";
1046 left(timestamp,$size) as timestamp,
1049 avg(loadavg) as loadavg
1057 my $sth = $self->{db}->prepare ($statement);
1060 ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
1065 my $status = $sth->execute;
1068 ($err, $msg) = $self->_dberror ('Unable to execute statement', $statement);
1075 while (my $row = $sth->fetchrow_hashref) {
1076 push @records, $row;
1082 sub GetLatestLoadavg ($) {
1083 my ($self, $system) = @_;
1085 $system = $self->_aliasSystem ($system);
1090 my @records = $self->_getRecords (
1093 . " order by timestamp desc limit 0, 1",
1097 return %{$records[0]};
1101 } # GetLatestLoadavg
1104 my ($self, %task) = @_;
1106 my @requiredFields = (
1111 my $result = _checkRequiredFields \@requiredFields, \%task;
1113 return -1, "AddTask: $result"
1116 return $self->_addRecord ('task', %task);
1119 sub DeleteTask ($) {
1120 my ($self, $name) = @_;
1122 return $self->_deleteRecord ('task', "name='$name'");
1126 my ($self, $name) = @_;
1130 my $condition = "name like '%$name%'";
1132 return $self->_getRecords ('task', $condition);
1136 my ($self, $name) = @_;
1141 my @records = $self->_getRecords ('task', "name='$name'");
1144 return %{$records[0]};
1150 sub UpdateTask ($%) {
1151 my ($self, $name, %update) = @_;
1153 return $self->_updateRecord ('task', "name='$name'", %update);
1156 sub AddSchedule (%) {
1157 my ($self, %schedule) = @_;
1159 my @requiredFields = (
1163 my $result = _checkRequiredFields \@requiredFields, \%schedule;
1165 return -1, "AddSchedule: $result"
1168 return $self->_addRecord ('schedule', %schedule);
1171 sub DeleteSchedule ($) {
1172 my ($self, $name) = @_;
1174 return $self->_deleteRecord ('schedule', "name='$name'");
1177 sub FindSchedule (;$$) {
1178 my ($self, $name, $task) = @_;
1183 my $condition = "name like '%$name%'";
1184 $condition .= ' and ';
1185 $condition .= "task like '%$task%'";
1187 return $self->_getRecords ('schedule', $condition);
1190 sub GetSchedule ($) {
1191 my ($self, $name) = @_;
1193 my @records = $self->_getRecords ('schedule', "name='$name'");
1196 return %{$records[0]};
1202 sub UpdateSchedule ($%) {
1203 my ($self, $name, %update) = @_;
1205 return $self->_updateRecord ('schedule', "name='$name'", %update);
1209 my ($self, %runlog) = @_;
1211 my @requiredFields = (
1215 my $result = _checkRequiredFields \@requiredFields, \%runlog;
1217 return -1, "AddRunlog: $result"
1220 $runlog{ended} = Today2SQLDatetime;
1222 my ($err, $msg) = $self->_addRecord ('runlog', %runlog);
1224 return ($err, $msg, $self->_getLastID);
1227 sub DeleteRunlog ($) {
1228 my ($self, $condition) = @_;
1230 return $self->_deleteRecord ('runlog', $condition);
1233 sub FindRunlog (;$$$$$$) {
1234 my ($self, $task, $system, $status, $id, $start, $page) = @_;
1238 # If ID is specified then that's all that really matters as it uniquely
1239 # identifies a runlog entry;
1243 $condition = "task like '%$task%'";
1246 $condition .= " and system like '%$system%'"
1247 unless $system eq 'All';
1249 $condition .= ' and system is null';
1252 if (defined $status) {
1253 if ($status =~ /!(-*\d+)/) {
1254 $condition .= " and status<>$1";
1256 $condition .= " and status=$status"
1260 $condition .= " order by started desc";
1262 if (defined $start) {
1264 $condition .= " limit $start, $page";
1267 $condition = "id=$id";
1270 return $self->_getRecords ('runlog', $condition);
1274 my ($self, $id) = @_;
1279 my @records = $self->_getRecords ('runlog', "id=$id");
1282 return %{$records[0]};
1288 sub UpdateRunlog ($%) {
1289 my ($self, $id, %update) = @_;
1291 return $self->_updateRecord ('runlog', "id=$id", %update);
1295 my ($self, $table, $condition) = @_;
1297 $condition = $condition ? 'where ' . $condition : '';
1301 my $statement = "select count(*) from $table $condition";
1303 my $sth = $self->{db}->prepare ($statement);
1306 ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
1311 my $status = $sth->execute;
1314 ($err, $msg) = $self->_dberror ('Unable to execute statement', $statement);
1319 # Hack! Statements such as the following:
1321 # select count(*) from fs where system='jupiter' and filesystem='/dev/sdb5'
1322 # > group by left(timestamp,10);
1334 # 7 rows in set (0.00 sec)
1336 # Here we want 7 but what we see in $records[0] is 49. So the hack is that if
1337 # statement contains "group by" then we assume we have the above and return
1338 # scalar @records, otherwise we return $records[0];
1339 if ($statement =~ /group by/i) {
1340 my $allrows = $sth->fetchall_arrayref;
1342 return scalar @{$allrows};
1344 my @records = $sth->fetchrow_array;
1350 # GetWork returns two items, the number of seconds to wait before the next task
1351 # and array of hash records of work to be done immediately. The caller should
1352 # execute the work to be done, timing it, and subtracting it from the $sleep
1353 # time returned. If the caller exhausts the $sleep time then they should call
1360 my $statement = <<"END";
1362 schedule.name as schedulename,
1364 task.system as system,
1366 schedule.notification,
1368 runlog.started as lastrun
1371 schedule left join runlog on schedule.lastrunid=runlog.id
1373 schedule.task=task.name
1374 and schedule.active='true'
1378 my $sth = $self->{db}->prepare ($statement);
1381 ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
1386 my $status = $sth->execute;
1389 ($err, $msg) = $self->_dberror ('Unable to execute statement', $statement);
1397 while (my $row = $sth->fetchrow_hashref) {
1398 if ($$row{system} !~ /localhost/i) {
1399 my %system = $self->GetSystem ($$row{system});
1401 # Skip inactive systems
1402 next if $system{active} eq 'false';
1405 # If started is not defined then this task was never run so run it now.
1406 unless ($$row{lastrun}) {
1407 push @records, $row;
1411 # TODO: Handle frequencies better.
1414 if ($$row{frequency} =~ /(\d+) seconds/i) {
1416 } elsif ($$row{frequency} =~ /(\d+) minute/i) {
1418 } elsif ($$row{frequency} =~ /(\d+) hour/i) {
1419 $seconds = $1 * 60 * 60;
1420 } elsif ($$row{frequency} =~ /(\d+) day/i) {
1421 $seconds= $1 * 60 * 60 * 24;
1423 warning "Don't know how to handle frequencies like $$row{frequency}";
1427 my $today = Today2SQLDatetime;
1428 my $lastrun = Add ($$row{lastrun}, (seconds => $seconds));
1429 my $waitTime = DateToEpoch ($lastrun) - DateToEpoch ($today);
1431 if ($waitTime < 0) {
1432 # We're late - push this onto records and move on
1433 push @records, $row;
1436 $sleep ||= $waitTime;
1438 if ($sleep > $waitTime) {
1443 # Even if there is nothing to do the caller should sleep a bit and come back
1444 # to us. So if it ends up there's nothing past due, and nothing upcoming, then
1445 # sleep for a minute and return here. Somebody may have added a new task next
1446 # time we're called.
1447 if (@records == 0 and not $sleep) {
1451 return ($sleep, @records);
1454 sub GetUniqueList ($$) {
1455 my ($self, $table, $field) = @_;
1459 my $statement = "select $field from $table group by $field";
1461 my $sth = $self->{db}->prepare ($statement);
1464 ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
1469 my $status = $sth->execute;
1472 ($err, $msg) = $self->_dberror ('Unable to execute statement', $statement);
1479 while (my @row = $sth->fetchrow_array) {
1481 push @values, $row[0];
1483 push @values, '<NULL>';
1491 my ($self, %alert) = @_;
1493 my @requiredFields = (
1498 my $result = _checkRequiredFields \@requiredFields, \%alert;
1500 return -1, "AddAlert: $result"
1503 return $self->_addRecord ('alert', %alert);
1506 sub DeleteAlert ($) {
1507 my ($self, $name) = @_;
1509 return $self->_deleteRecord ('alert', "name='$name'");
1512 sub FindAlert (;$) {
1513 my ($self, $alert) = @_;
1517 my $condition = "name like '%$alert%'";
1519 return $self->_getRecords ('alert', $condition);
1523 my ($self, $name) = @_;
1528 my @records = $self->_getRecords ('alert', "name='$name'");
1531 return %{$records[0]};
1537 sub SendAlert ($$$$$$$) {
1549 my $footing = '<hr><p style="text-align: center;">';
1550 $footing .= '<font color="#bbbbbb">';
1551 my $year = (localtime)[5] + 1900;
1552 $footing .= "<a href='$CLEAROPTS{CLEARADM_WEBBASE}'>Clearadm</a><br>";
1553 $footing .= "Copyright © $year, ClearSCM, Inc. - All rights reserved";
1555 my %alert = $self->GetAlert ($alert);
1557 if ($alert{type} eq 'email') {
1558 my $from = 'Clearadm@' . hostdomain;
1563 subject => "Clearadm Alert: $system: $subject",
1566 footing => $footing,
1569 $self->Error ("Don't know how to send $alert{type} alerts\n"
1570 . "Subject: $subject\n"
1571 . "Message: $message", 1);
1578 notification => $notification,
1579 runlog => $runlogID,
1580 timestamp => Today2SQLDatetime,
1581 message => $subject,
1584 return $self->AddAlertlog (%alertlog);
1587 sub GetLastAlert ($$) {
1588 my ($self, $notification, $system) = @_;
1590 my $statement = <<"END";
1597 notification='$notification'
1598 and system='$system'
1605 my $sth = $self->{db}->prepare ($statement)
1606 or return $self->_dberror ('Unable to prepare statement', $statement);
1609 or return $self->_dberror ('Unable to execute statement', $statement);
1611 my $alertlog= $sth->fetchrow_hashref;
1622 sub GetLastTaskFailure ($$) {
1623 my ($self, $task, $system) = @_;
1625 my $statement = <<"END";
1634 and system='$system'
1642 my $sth = $self->{db}->prepare ($statement)
1643 or return $self->_dberror ('Unable to prepare statement', $statement);
1646 or return $self->_dberror ('Unable to execute statement', $statement);
1648 my $runlog= $sth->fetchrow_hashref;
1652 if ($$runlog{ended}) {
1656 # If we didn't get any ended in the last call then there's nothing that
1657 # qualified. Still let's return a record (%runlog) that has a valid id so
1658 # that the caller can update that runlog with alerted = 'true'.
1659 $statement = <<"END";
1667 and system='$system'
1674 $sth = $self->{db}->prepare ($statement)
1675 or return $self->_dberror ('Unable to prepare statement', $statement);
1678 or return $self->_dberror ('Unable to execute statement', $statement);
1680 $runlog = $sth->fetchrow_hashref;
1689 } # GetLastTaskFailure
1691 sub Notify ($$$$$$) {
1703 $runlogID = $self->_getLastID
1708 # Update filesystem, if $filesystem was specified
1710 ($err, $msg) = $self->UpdateFilesystem (
1713 notification => $notification,
1717 $self->Error ("Unable to set notification for filesystem $system:$filesystem "
1718 . "(Status: $err)\n$msg", $err) if $err;
1722 ($err, $msg) = $self->UpdateSystem (
1724 notification => $notification,
1728 my %notification = $self->GetNotification ($notification);
1730 my %lastnotified = $self->GetLastAlert ($notification, $system);
1732 if (%lastnotified and $lastnotified{timestamp}) {
1733 my $today = Today2SQLDatetime;
1734 my $lastnotified = $lastnotified{timestamp};
1736 if ($notification{nomorethan} =~ /hour/i) {
1737 $lastnotified = Add ($lastnotified, (hours => 1));
1738 } elsif ($notification{nomorethan} =~ /day/i) {
1739 $lastnotified = Add ($lastnotified, (days => 1));
1740 } elsif ($notification{nomorethan} =~ /week/i) {
1741 $lastnotified = Add ($lastnotified, (days => 7));
1742 } elsif ($notification{nomorethan} =~ /month/i) {
1743 $lastnotified = Add ($lastnotified, (month => 1));
1746 # If you want to fake an alert in the debugger just change $diff accordingly
1747 my $diff = Compare ($today, $lastnotified);
1753 my $when = Today2SQLDatetime;
1754 my $nomorethan = lc $notification{nomorethan};
1755 my %alert = $self->GetAlert ($notification{alert});
1756 my $to = $alert{who};
1758 # If $to is null then this means to send the alert to the admin for the
1762 my %system = $self->GetSystem ($system);
1764 $to = $system{email};
1766 # If we don't know what system this error occurred on we'll have to notify
1767 # the "super user" defined as $self->{NOTIFY} (The receiver of last
1769 $to = $self->{NOTIFY};
1774 Error "To undefined";
1777 $message .= "<p>You will receive this alert no more than $nomorethan.</p>";
1779 ($err, $msg) = $self->SendAlert (
1780 $notification{alert},
1782 $notification{name},
1789 $self->Error ("Unable to send alert (Status: $err)\n$msg", $err) if $err;
1791 verbose "Sent alert to $to";
1793 # Update runlog to indicate we notified the user for this execution
1794 ($err, $msg) = $self->UpdateRunlog (
1800 $self->Error ("Unable to update runlog (Status: $err)\n$msg", $err) if $err;
1805 sub ClearNotifications ($$;$) {
1806 my ($self, $system, $filesystem) = @_;
1811 ($err, $msg) = $self->UpdateFilesystem (
1813 $filesystem, (notification => undef),
1816 error "Unable to clear notification for filesystem $system:$filesystem "
1817 . "(Status: $err)\n$msg", $err
1820 # Check to see any of this system's filesystems have notifications. If none
1821 # then it's save to say we've turned off the last notification for a
1822 # filesystem involved with this system and if $system{notification} was
1823 # 'Filesystem' then we can toggle off the notification on the system too
1824 my $filesystemsAlerted = 0;
1826 foreach ($self->FindFilesystem ($system)) {
1827 $filesystemsAlerted++
1828 if $$_{notification};
1831 my %system = $self->GetSystem ($system);
1836 if ($system{notification} and
1837 $system{notification} eq 'Filesystem' and
1838 $filesystemsAlerted == 0) {
1839 ($err, $msg) = $self->UpdateSystem ($system, (notification => undef));
1841 $self->Error ("Unable to clear notification for system $system "
1842 . "(Status: $err)\n$msg", $err) if $err;
1845 ($err, $msg) = $self->UpdateSystem ($system, (notification => undef));
1847 $self->Error ("Unable to clear notification for system $system "
1848 . "(Status: $err)\n$msg", $err) if $err;
1852 } # ClearNotifications
1854 sub SystemAlive (%) {
1855 my ($self, %system) = @_;
1857 # If we've never heard from this system then we will assume that the system
1858 # has not been set up to run clearagent and has never checked in. In any event
1859 # we cannot say the system died because we've never known it to be alive!
1861 unless $system{lastheardfrom};
1863 # If a system is not active (may have been temporarily been deactivated) then
1864 # we don't want to turn on the bells and whistles alerting people it's down.
1866 if $system{active} eq 'false';
1868 my $today = Today2SQLDatetime;
1869 my $lastheardfrom = $system{lastheardfrom};
1871 my $tenMinutes = 10 * 60;
1873 $lastheardfrom = Add ($lastheardfrom, (seconds => $tenMinutes));
1875 if (DateToEpoch ($lastheardfrom) < DateToEpoch ($today)) {
1876 $self->UpdateSystem (
1878 notification => 'Heartbeat'
1884 if ($system{notification}) {
1885 $self->UpdateSystem (
1887 notification => undef
1895 sub UpdateAlert ($%) {
1896 my ($self, $name, %update) = @_;
1898 return $self->_updateRecord (
1905 sub AddAlertlog (%) {
1906 my ($self, %alertlog) = @_;
1908 my @requiredFields = (
1913 my $result = _checkRequiredFields \@requiredFields, \%alertlog;
1915 return -1, "AddAlertlog: $result"
1919 $alertlog{timestamp} = Today2SQLDatetime;
1921 return $self->_addRecord ('alertlog', %alertlog);
1924 sub DeleteAlertlog ($) {
1925 my ($self, $condition) = @_;
1930 if ($condition =~ /all/i) {
1931 return $self->_deleteRecord ('alertlog');
1933 return $self->_deleteRecord ('alertlog', $condition);
1937 sub FindAlertlog (;$$$$$) {
1938 my ($self, $alert, $system, $notification, $start, $page) = @_;
1942 $notification ||= '';
1944 my $condition = "alert like '%$alert%'";
1945 $condition .= ' and ';
1946 $condition .= "system like '%$system%'";
1947 $condition .= ' and ';
1948 $condition .= "notification like '%$notification%'";
1949 $condition .= " order by timestamp desc";
1951 if (defined $start) {
1953 $condition .= " limit $start, $page";
1956 return $self->_getRecords ('alertlog', $condition);
1959 sub GetAlertlog ($) {
1960 my ($self, $alert) = @_;
1965 my @records = $self->_getRecords ('alertlog', "alert='$alert'");
1968 return %{$records[0]};
1974 sub UpdateAlertlog ($%) {
1975 my ($self, $alert, %update) = @_;
1977 return $self->_updateRecord (
1984 sub AddNotification (%) {
1985 my ($self, %notification) = @_;
1987 my @requiredFields = (
1993 my $result = _checkRequiredFields \@requiredFields, \%notification;
1995 return -1, "AddNotification: $result"
1998 return $self->_addRecord ('notification', %notification);
2001 sub DeleteNotification ($) {
2002 my ($self, $name) = @_;
2004 return $self->_deleteRecord ('notification', "name='$name'");
2007 sub FindNotification (;$$) {
2008 my ($self, $name, $cond, $ordering) = @_;
2012 my $condition = "name like '%$name%'";
2013 $condition .= " and $cond"
2016 return $self->_getRecords ('notification', $condition);
2017 } # FindNotification
2019 sub GetNotification ($) {
2020 my ($self, $name) = @_;
2025 my @records = $self->_getRecords ('notification', "name='$name'");
2028 return %{$records[0]};
2034 sub UpdateNotification ($%) {
2035 my ($self, $name, %update) = @_;
2037 return $self->_updateRecord (
2042 } # UpdateNotification
2048 =head1 CONFIGURATION AND ENVIRONMENT
2050 DEBUG: If set then $debug is set to this level.
2052 VERBOSE: If set then $verbose is set to this level.
2054 TRACE: If set then $trace is set to this level.
2066 L<Net::Domain|Net::Domain>
2068 =head2 ClearSCM Perl Modules
2082 <a href="http://clearscm.com/php/scm_man.php?file=lib/DateUtils.pm">DateUtils</a><br>
2083 <a href="http://clearscm.com/php/scm_man.php?file=lib/Display.pm">Display</a><br>
2084 <a href="http://clearscm.com/php/scm_man.php?file=lib/GetConfig.pm">GetConfig</a><br>
2085 <a href="http://clearscm.com/php/scm_man.php?file=lib/Mail.pm">Mail</a><br>
2090 =head1 BUGS AND LIMITATIONS
2092 There are no known bugs in this module
2094 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
2096 =head1 LICENSE AND COPYRIGHT
2098 Copyright (c) 2010, ClearSCM, Inc. All rights reserved.