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);
95 use lib "$FindBin::Bin", "$FindBin::Bin/../../lib";
102 my $conf = dirname(__FILE__) . '/../etc/clearadm.conf';
104 our %CLEAROPTS = GetConfig($conf);
107 our $VERSION = '$Revision: 1.54 $';
108 ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
110 $CLEAROPTS{CLEARADM_USERNAME} = $ENV{CLEARADM_USERNAME}
111 ? $ENV{CLEARADM_USERNAME}
112 : $CLEAROPTS{CLEARADM_USERNAME}
113 ? $CLEAROPTS{CLEARADM_USERNAME}
115 $CLEAROPTS{CLEARADM_PASSWORD} = $ENV{CLEARADM_PASSWORD}
116 ? $ENV{CLEARADM_PASSWORD}
117 : $CLEAROPTS{CLEARADM_PASSWORD}
118 ? $CLEAROPTS{CLEARADM_PASSWORD}
120 $CLEAROPTS{CLEARADM_SERVER} = $ENV{CLEARADM_SERVER}
121 ? $ENV{CLEARADM_SERVER}
122 : $CLEAROPTS{CLEARADM_SERVER}
123 ? $CLEAROPTS{CLEARADM_SERVER}
126 my $defaultFilesystemThreshold = 90;
127 my $defaultFilesystemHist = '6 months';
128 my $defaultLoadavgHist = '6 months';
132 my ($self, $msg, $statement) = @_;
134 my $dberr = $self->{db}->err;
135 my $dberrmsg = $self->{db}->errstr;
138 $dberrmsg ||= 'Success';
143 my $function = (caller(1)) [3];
145 $message = "$function: $msg\nError #$dberr: $dberrmsg\n"
146 . "SQL Statement: $statement";
149 return $dberr, $message;
152 sub _formatValues(@) {
153 my ($self, @values) = @_;
158 push @returnValues, $_ eq '' ? 'null' : $self->{db}->quote($_)
161 return @returnValues;
164 sub _formatNameValues(%) {
165 my ($self, %rec) = @_;
169 push @nameValueStrs, "$_=" . $self->{db}->quote($rec{$_})
172 return @nameValueStrs;
173 } # _formatNameValues
176 my ($self, $table, %rec) = @_;
178 my $statement = "insert into $table (";
179 $statement .= join ',', keys %rec;
180 $statement .= ') values (';
181 $statement .= join ',', $self->_formatValues(values %rec);
186 $self->{db}->do($statement);
188 return $self->_dberror("Unable to add record to $table", $statement);
191 sub _deleteRecord($;$) {
192 my ($self, $table, $condition) = @_;
196 my $statement = "select count(*) from $table ";
197 $statement .= "where $condition"
200 my $sth = $self->{db}->prepare($statement)
201 or return $self->_dberror('Unable to prepare statement', $statement);
204 or return $self->_dberror('Unable to execute statement', $statement);
206 my @row = $sth->fetchrow_array;
216 return ($count, 'Records deleted')
219 $statement = "delete from $table ";
220 $statement .= "where $condition"
223 $self->{db}->do($statement);
225 if ($self->{db}->err) {
226 return $self->_dberror("Unable to delete record from $table", $statement);
228 return $count, 'Records deleted';
232 sub _updateRecord($$%) {
233 my ($self, $table, $condition, %rec) = @_;
235 my $statement = "update $table set ";
236 $statement .= join ',', $self->_formatNameValues(%rec);
237 $statement .= " where $condition"
240 $self->{db}->do($statement);
242 return $self->_dberror("Unable to update record in $table", $statement);
245 sub _checkRequiredFields($$) {
246 my ($fields, $rec) = @_;
248 for my $fieldname (@$fields) {
252 if ($fieldname eq $_) {
258 return "$fieldname is required"
263 } # _checkRequiredFields
265 sub _getRecords($$;$) {
266 my ($self, $table, $condition, $additional) = @_;
272 my $statement = "select * from $table";
273 $statement .= " where $condition" if $condition;
274 $statement .= $additional;
276 my $sth = $self->{db}->prepare($statement);
279 ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
289 # We've been having the server going away. Supposedly it should reconnect so
290 # here we simply retry up to $maxAttempts times to re-execute the statement.
291 # (Are there other places where we need to do this?)
294 while ($err == 2006 and $attempts++ < $maxAttempts) {
295 $status = $sth->execute;
301 ($err, $msg) = $self->_dberror('Unable to execute statement',
307 croak $msg unless $err == 2006;
309 my $timestamp = YMDHMS;
311 $self->Error("$timestamp: Unable to talk to DB server.\n\n$msg\n\n"
312 . "Will try again in $sleepTime seconds", -1);
315 $self->_connect($self->{dbserver});
320 $self->Error("After $maxAttempts attempts I could not connect to the database", $err)
321 if ($err == 2006 and $attempts > $maxAttempts);
325 while (my $row = $sth->fetchrow_hashref) {
332 sub _aliasSystem($) {
333 my ($self, $system) = @_;
335 my %system = $self->GetSystem($system);
338 return $system{name};
347 my $statement = 'select last_insert_id()';
349 my $sth = $self->{db}->prepare($statement);
354 ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
359 my $status = $sth->execute;
362 ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
369 my @row = $sth->fetchrow_array;
375 my ($self, $dbserver) = @_;
377 $dbserver ||= $CLEAROPTS{CLEARADM_SERVER};
379 my $dbname = 'clearadm';
380 my $dbdriver = 'mysql';
382 $self->{db} = DBI->connect(
383 "DBI:$dbdriver:$dbname:$dbserver",
384 $CLEAROPTS{CLEARADM_USERNAME},
385 $CLEAROPTS{CLEARADM_PASSWORD},
388 "Couldn't connect to $dbname database "
389 . "as $CLEAROPTS{CLEARADM_USERNAME}\@$CLEAROPTS{CLEARADM_SERVER}"
392 $self->{dbserver} = $dbserver;
398 my ($class, $dbserver) = @_;
400 my $self = bless {}, $class;
402 $self->_connect($dbserver);
410 $self->{NOTIFY} = $CLEAROPTS{CLEARADM_NOTIFY};
416 my ($self, $msg, $errno) = @_;
418 # If $errno is specified we need to stop. However we need to notify somebody
419 # that cleartasks is no longer running.
423 if ($self->{NOTIFY}) {
425 to => $self->{NOTIFY},
426 subject => 'Internal error occurred in Clearadm',
427 data => "<p>An unexpected, internal error occurred in Clearadm:</p><p>$msg</p>",
431 exit $errno if $errno > 0;
439 my ($self, %system) = @_;
441 my @requiredFields = (
445 my $result = _checkRequiredFields \@requiredFields, \%system;
447 return -1, "AddSystem: $result"
450 $system{loadavgHist} ||= $defaultLoadavgHist;
452 return $self->_addRecord('system', %system);
455 sub DeleteSystem($) {
456 my ($self, $name) = @_;
458 return $self->_deleteRecord('system', "name='$name'");
461 sub UpdateSystem ($%) {
462 my ($self, $name, %update) = @_;
464 return $self->_updateRecord('system', "name='$name'", %update);
468 my ($self, $system) = @_;
473 my @records = $self->_getRecords(
475 "name='$system' or alias like '%$system%'"
479 return %{$records[0]};
486 my ($self, $system) = @_;
490 my $condition = "name like '%$system%' or alias like '%$system%'";
492 return $self->_getRecords('system', $condition);
495 sub SearchSystem(;$) {
\r
496 my ($self, $condition) = @_;
498 $condition = "name like '%'" unless $condition;
500 return $self->_getRecords('system', $condition);
\r
504 my ($self, %package) = @_;
506 my @requiredFields = (
512 my $result = _checkRequiredFields \@requiredFields, \%package;
514 return -1, "AddPackage: $result"
517 return $self->_addRecord('package', %package);
520 sub DeletePackage($$) {
521 my ($self, $system, $name) = @_;
523 return $self->_deleteRecord(
525 "(system='$system' or alias='$system') and name='$name'");
528 sub UpdatePackage($$%) {
529 my ($self, $system, $name, %update) = @_;
531 $system = $self->_aliasSystem($system);
536 return $self->_updateRecord('package', "system='$system'", %update);
540 my ($self, $system, $name) = @_;
542 $system = $self->_aliasSystem($system);
550 my @records = $self->_getRecords(
552 "system='$system' and name='$name'"
556 return %{$records[0]};
562 sub FindPackage($;$) {
563 my ($self, $system, $name) = @_;
567 $system = $self->_aliasSystem($system);
572 my $condition = "system='$system' and name like '%$name%'";
574 return $self->_getRecords('package', $condition);
577 sub AddFilesystem(%) {
578 my ($self, %filesystem) = @_;
580 my @requiredFields = (
586 my $result = _checkRequiredFields \@requiredFields, \%filesystem;
588 return -1, "AddFilesystem: $result"
591 # Default filesystem threshold
592 $filesystem{threshold} ||= $defaultFilesystemThreshold;
594 return $self->_addRecord('filesystem', %filesystem);
597 sub DeleteFilesystem($$) {
598 my ($self, $system, $filesystem) = @_;
600 $system = $self->_aliasSystem($system);
605 return $self->_deleteRecord(
607 "system='$system' and filesystem='$filesystem'"
611 sub UpdateFilesystem($$%) {
612 my ($self, $system, $filesystem, %update) = @_;
614 $system = $self->_aliasSystem($system);
619 return $self->_updateRecord(
621 "system='$system' and filesystem='$filesystem'",
626 sub GetFilesystem($$) {
627 my ($self, $system, $filesystem) = @_;
629 $system = $self->_aliasSystem($system);
637 my @records = $self->_getRecords(
639 "system='$system' and filesystem='$filesystem'"
643 return %{$records[0]};
649 sub FindFilesystem($;$) {
650 my ($self, $system, $filesystem) = @_;
654 $system = $self->_aliasSystem($system);
659 my $condition = "system='$system' and filesystem like '%$filesystem%'";
661 return $self->_getRecords('filesystem', $condition);
665 my ($self, %vob) = @_;
667 my @requiredFields = (
672 my $result = _checkRequiredFields \@requiredFields, \%vob;
674 return -1, "AddVob: $result"
677 return $self->_addRecord('vob', %vob);
681 my ($self, $tag) = @_;
683 return $self->_deleteRecord('vob', "tag='$tag'");
687 my ($self, $tag) = @_;
692 my @records = $self->_getRecords('vob', "tag='$tag'");
695 return %{$records[0]};
702 my ($self, $tag) = @_;
704 return $self->_getRecords('vob', "tag like '%$tag%'");
708 my ($self, %view) = @_;
710 my @requiredFields = (
715 my $result = _checkRequiredFields \@requiredFields, \%view;
717 return -1, "AddView: $result"
720 return $self->_addRecord('view', %view);
724 my ($self, $tag) = @_;
726 return $self->_deleteRecord('vob', "tag='$tag'");
730 my ($self, $tag, $region, %viewRec) = @_;
732 return $self->_updateRecord('view', "tag='$tag' and region='$region'", %viewRec);
736 my ($self, $tag, $region) = @_;
740 my @records = $self->_getRecords('view', "tag='$tag' and region='$region'");
743 return %{$records[0]};
749 sub FindView(;$$$$) {
750 my ($self, $system, $region, $tag, $ownerName) = @_;
759 $condition = "system like '%$system%'";
760 $condition .= ' and ';
761 $condition = "region like '%$region%'";
762 $condition .= ' and ';
763 $condition .= "tag like '%$tag'";
764 $condition .= ' and ';
765 $condition .= "ownerName like '%$ownerName'";
767 return $self->_getRecords('view', $condition);
771 my ($self, %fs) = @_;
773 my @requiredFields = (
778 my $result = _checkRequiredFields \@requiredFields, \%fs;
780 return -1, "AddFS: $result"
784 $fs{timestamp} = Today2SQLDatetime;
786 return $self->_addRecord('fs', %fs);
790 my ($self, $system, $filesystem) = @_;
792 my %filesystem = $self->GetFilesystem($system, $filesystem);
797 my %task = $self->GetTask('scrub');
799 $self->Error("Unable to find scrub task!", 1) unless %task;
802 my $today = Today2SQLDatetime;
804 # TODO: SubtractDays uses just an approximation (i.e. subtracting 30 days when
805 # in February is not right.
806 if ($filesystem{filesystemHist} =~ /(\d+) month/i) {
808 } elsif ($filesystem{filesystemHist} =~ /(\d+) year/i) {
812 my $oldage = SubtractDays $today, $days;
814 my ($dberr, $dbmsg) = $self->_deleteRecord(
816 "system='$system' and filesystem='$filesystem' and timestamp<='$oldage'"
819 if ($dbmsg eq 'Records deleted') {
825 $runlog{task} = $task{name};
826 $runlog{started} = $today;
829 "Scrubbed $dberr fs records for filesystem $system:$filesystem";
831 my ($err, $msg) = $self->AddRunlog(%runlog);
833 $self->Error("Unable to add runlog - (Error: $err)\n$msg") if $err;
836 return ($dberr, $dbmsg);
840 my ($self, $system) = @_;
842 my %system = $self->GetSystem($system);
847 my %task = $self->GetTask('loadavg');
849 $self->Error("Unable to find loadavg task!", 1) unless %task;
852 my $today = Today2SQLDatetime;
854 # TODO: SubtractDays uses just an approximation (i.e. subtracting 30 days when
855 # in February is not right.
856 if ($system{loadavgHist} =~ /(\d+) month/i) {
858 } elsif ($system{loadavgHist} =~ /(\d+) year/i) {
862 my $oldage = SubtractDays $today, $days;
864 my ($dberr, $dbmsg) = $self->_deleteRecord(
866 "system='$system' and timestamp<='$oldage'"
869 if ($dbmsg eq 'Records deleted') {
875 $runlog{task} = $task{name};
876 $runlog{started} = $today;
879 "Scrubbed $dberr loadavg records for system $system";
881 my ($err, $msg) = $self->AddRunlog(%runlog);
883 $self->Error("Unable to add runload (Error: $err)\n$msg") if $err;
886 return ($dberr, $dbmsg);
890 my ($self, $system, $filesystem, $start, $end, $count, $interval) = @_;
892 $system = $self->_aliasSystem($system);
900 $interval ||= 'Minute';
902 my $size = $interval =~ /month/i
904 : $interval =~ /day/i
906 : $interval =~ /hour/i
910 undef $start if $start and $start =~ /earliest/i;
911 undef $end if $end and $end =~ /latest/i;
913 my $condition = "system='$system' and filesystem='$filesystem'";
914 $condition .= " and timestamp>='$start'" if $start;
915 $condition .= " and timestamp<='$end'" if $end;
917 $condition .= " group by left(timestamp,$size)";
920 # We can't simply do a "limit 0, $count" as that just gets the front end of
921 # the records return (i.e. if $count = say 10 and the timestamp range
922 # returns 40 rows we'll see only rows 1-10, not rows 31-40). We need limit
923 # $offset, $count where $offset = the number of qualifying records minus
925 my $nbrRecs = $self->Count('fs', $condition);
926 my $offset = $nbrRecs - $count;
928 # Offsets of < 0 are not allowed.
932 $condition .= " limit $offset, $count";
935 my $statement = <<"END";
940 left(timestamp,$size) as timestamp,
952 my $sth = $self->{db}->prepare($statement);
955 ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
960 my $status = $sth->execute;
963 ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
970 while (my $row = $sth->fetchrow_hashref) {
977 sub GetLatestFS($$) {
978 my ($self, $system, $filesystem) = @_;
980 $system = $self->_aliasSystem($system);
988 my @records = $self->_getRecords(
990 "system='$system' and filesystem='$filesystem'"
991 . " order by timestamp desc limit 0, 1",
995 return %{$records[0]};
1002 my ($self, %loadavg) = @_;
1004 my @requiredFields = (
1008 my $result = _checkRequiredFields \@requiredFields, \%loadavg;
1010 return -1, "AddLoadavg: $result"
1014 $loadavg{timestamp} = Today2SQLDatetime;
1016 return $self->_addRecord('loadavg', %loadavg);
1019 sub GetLoadavg($;$$$$) {
1020 my ($self, $system, $start, $end, $count, $interval) = @_;
1022 $system = $self->_aliasSystem($system);
1027 $interval ||= 'Minute';
1029 my $size = $interval =~ /month/i
1031 : $interval =~ /day/i
1033 : $interval =~ /hour/i
1039 undef $start if $start and $start =~ /earliest/i;
1040 undef $end if $end and $end =~ /latest/i;
1042 $condition .= " system='$system'" if $system;
1043 $condition .= " and timestamp>='$start'" if $start;
1044 $condition .= " and timestamp<='$end'" if $end;
1046 $condition .= " group by left(timestamp,$size)";
1049 # We can't simply do a "limit 0, $count" as that just gets the front end of
1050 # the records return (i.e. if $count = say 10 and the timestamp range
1051 # returns 40 rows we'll see only rows 1-10, not rows 31-40). We need limit
1052 # $offset, $count where $offset = the number of qualifying records minus
1054 my $nbrRecs = $self->Count('loadavg', $condition);
1055 my $offset = $nbrRecs - $count;
1057 # Offsets of < 0 are not allowed.
1061 $condition .= " limit $offset, $count";
1064 my $statement = <<"END";
1067 left(timestamp,$size) as timestamp,
1070 avg(loadavg) as loadavg
1078 my $sth = $self->{db}->prepare($statement);
1081 ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
1086 my $status = $sth->execute;
1089 ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
1096 while (my $row = $sth->fetchrow_hashref) {
1097 push @records, $row;
1103 sub GetLatestLoadavg($) {
1104 my ($self, $system) = @_;
1106 $system = $self->_aliasSystem($system);
1111 my @records = $self->_getRecords(
1114 . " order by timestamp desc limit 0, 1",
1118 return %{$records[0]};
1122 } # GetLatestLoadavg
1124 sub GetStorage($$$;$$$$$) {
1125 my ($self, $type, $tag, $storage, $region, $start, $end, $count, $interval) = @_;
1127 $interval ||= 'Day';
1128 $region ||= $Clearcase::CC->region;
1130 return unless $type =~ /vob/i or $type =~ /view/;
1132 my $size = $interval =~ /month/i
1134 : $interval =~ /day/i
1136 : $interval =~ /hour/i
1140 undef $start if $start and $start =~ /earliest/i;
1141 undef $end if $end and $end =~ /latest/i;
1144 my $table = $type eq 'vob' ? 'vobstorage' : 'viewstorage';
1146 $condition = "tag='$tag' and region='$region'";
1147 $condition .= " and timestamp>='$start'" if $start;
1148 $condition .= " and timestamp<='$end'" if $end;
1150 $condition .= " group by left(timestamp,$size)";
1153 # We can't simply do a "limit 0, $count" as that just gets the front end of
1154 # the records return (i.e. if $count = say 10 and the timestamp range
1155 # returns 40 rows we'll see only rows 1-10, not rows 31-40). We need limit
1156 # $offset, $count where $offset = the number of qualifying records minus
1158 my $nbrRecs = $self->Count($table, $condition);
1159 my $offset = $nbrRecs - $count;
1161 # Offsets of < 0 are not allowed.
1162 $offset = 0 if $offset < 0;
1164 $condition .= " limit $offset, $count";
1167 my $statement = <<"END";
1171 left(timestamp,$size) as timestamp,
1172 avg($storage) as size
1180 my $sth = $self->{db}->prepare($statement);
1183 ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
1188 my $status = $sth->execute;
1191 ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
1198 while (my $row = $sth->fetchrow_hashref) {
1199 push @records, $row;
1206 my ($self, %task) = @_;
1208 my @requiredFields = (
1213 my $result = _checkRequiredFields \@requiredFields, \%task;
1215 return -1, "AddTask: $result"
1218 return $self->_addRecord('task', %task);
1222 my ($self, $name) = @_;
1224 return $self->_deleteRecord('task', "name='$name'");
1228 my ($self, $name) = @_;
1232 my $condition = "name like '%$name%'";
1234 return $self->_getRecords('task', $condition);
1238 my ($self, $name) = @_;
1243 my @records = $self->_getRecords('task', "name='$name'");
1246 return %{$records[0]};
1252 sub UpdateTask($%) {
1253 my ($self, $name, %update) = @_;
1255 return $self->_updateRecord('task', "name='$name'", %update);
1258 sub AddSchedule(%) {
1259 my ($self, %schedule) = @_;
1261 my @requiredFields = (
1265 my $result = _checkRequiredFields \@requiredFields, \%schedule;
1267 return -1, "AddSchedule: $result"
1270 return $self->_addRecord('schedule', %schedule);
1273 sub DeleteSchedule($) {
1274 my ($self, $name) = @_;
1276 return $self->_deleteRecord('schedule', "name='$name'");
1279 sub FindSchedule(;$$) {
1280 my ($self, $name, $task) = @_;
1285 my $condition = "name like '%$name%'";
1286 $condition .= ' and ';
1287 $condition .= "task like '%$task%'";
1289 return $self->_getRecords('schedule', $condition);
1292 sub GetSchedule($) {
1293 my ($self, $name) = @_;
1295 my @records = $self->_getRecords('schedule', "name='$name'");
1298 return %{$records[0]};
1304 sub UpdateSchedule($%) {
1305 my ($self, $name, %update) = @_;
1307 return $self->_updateRecord('schedule', "name='$name'", %update);
1311 my ($self, %runlog) = @_;
1313 my @requiredFields = (
1317 my $result = _checkRequiredFields \@requiredFields, \%runlog;
1319 return -1, "AddRunlog: $result"
1322 $runlog{ended} = Today2SQLDatetime;
1324 $runlog{system} = hostname if $runlog{system} =~ /localhost/i;
1326 my ($err, $msg) = $self->_addRecord('runlog', %runlog);
1328 return ($err, $msg, $self->_getLastID);
1331 sub DeleteRunlog($) {
1332 my ($self, $condition) = @_;
1334 return $self->_deleteRecord('runlog', $condition);
1337 sub FindRunlog(;$$$$$$) {
1338 my ($self, $task, $system, $status, $id, $start, $page) = @_;
1340 # If ID is specified then that's all that really matters as it uniquely
1341 # identifies a runlog entry;
1342 my ($condition, $conditions);
1346 if ($task !~ /all/i) {
1348 $condition = "task like '%$task%'";
1351 if ($system !~ /all/i) {
1352 $condition .= ' and ' if $conditions;
1353 $condition .= "system like '%$system%'";
1358 $condition .= ' and ' if $conditions;
1360 if ($status =~ /!(-*\d+)/) {
1361 $condition .= "status<>$1";
1363 $condition .= "status=$status"
1367 # Need defined here as $start may be 0!
1368 if (defined $start) {
1370 $limit = "limit $start, $page";
1373 $condition = "id=$id";
1376 return $self->_getRecords('runlog', $condition, " order by started desc $limit");
1380 my ($self, $id) = @_;
1385 my @records = $self->_getRecords('runlog', "id=$id");
1388 return %{$records[0]};
1394 sub UpdateRunlog($%) {
1395 my ($self, $id, %update) = @_;
1397 return $self->_updateRecord('runlog', "id=$id", %update);
1401 my ($self, $table, $condition) = @_;
1403 $condition = $condition ? 'where ' . $condition : '';
1407 my $statement = "select count(*) from $table $condition";
1409 my $sth = $self->{db}->prepare($statement);
1412 ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
1417 my $status = $sth->execute;
1420 ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
1425 # Hack! Statements such as the following:
1427 # select count(*) from fs where system='jupiter' and filesystem='/dev/sdb5'
1428 # > group by left(timestamp,10);
1440 # 7 rows in set (0.00 sec)
1442 # Here we want 7 but what we see in $records[0] is 49. So the hack is that if
1443 # statement contains "group by" then we assume we have the above and return
1444 # scalar @records, otherwise we return $records[0];
1445 if ($statement =~ /group by/i) {
1446 my $allrows = $sth->fetchall_arrayref;
1448 return scalar @{$allrows};
1450 my @records = $sth->fetchrow_array;
1456 # GetWork returns two items, the number of seconds to wait before the next task
1457 # and array of hash records of work to be done immediately. The caller should
1458 # execute the work to be done, timing it, and subtracting it from the $sleep
1459 # time returned. If the caller exhausts the $sleep time then they should call
1466 my $statement = <<"END";
1468 schedule.name as schedulename,
1470 task.system as system,
1472 schedule.notification,
1474 runlog.started as lastrun
1477 schedule left join runlog on schedule.lastrunid=runlog.id
1479 schedule.task=task.name
1480 and schedule.active='true'
1484 my $sth = $self->{db}->prepare($statement);
1487 ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
1492 my $status = $sth->execute;
1495 ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
1503 while (my $row = $sth->fetchrow_hashref) {
1504 if ($$row{system} !~ /localhost/i) {
1505 my %system = $self->GetSystem($$row{system});
1507 # Skip inactive systems
1508 next if $system{active} eq 'false';
1511 # If started is not defined then this task was never run so run it now.
1512 unless ($$row{lastrun}) {
1513 push @records, $row;
1517 # TODO: Handle frequencies better.
1520 if ($$row{frequency} =~ /(\d+) seconds/i) {
1522 } elsif ($$row{frequency} =~ /(\d+) minute/i) {
1524 } elsif ($$row{frequency} =~ /(\d+) hour/i) {
1525 $seconds = $1 * 60 * 60;
1526 } elsif ($$row{frequency} =~ /(\d+) day/i) {
1527 $seconds= $1 * 60 * 60 * 24;
1529 warning "Don't know how to handle frequencies like $$row{frequency}";
1533 my $today = Today2SQLDatetime;
1534 my $lastrun = Add($$row{lastrun}, (seconds => $seconds));
1535 my $waitTime = DateToEpoch($lastrun) - DateToEpoch($today);
1537 if ($waitTime < 0) {
1538 # We're late - push this onto records and move on
1539 push @records, $row;
1542 $sleep ||= $waitTime;
1544 if ($sleep > $waitTime) {
1549 # Even if there is nothing to do the caller should sleep a bit and come back
1550 # to us. So if it ends up there's nothing past due, and nothing upcoming, then
1551 # sleep for a minute and return here. Somebody may have added a new task next
1552 # time we're called.
1553 if (@records == 0 and not $sleep) {
1557 return ($sleep, @records);
1560 sub GetUniqueList($$) {
1561 my ($self, $table, $field) = @_;
1565 my $statement = "select $field from $table group by $field";
1567 my $sth = $self->{db}->prepare($statement);
1570 ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
1575 my $status = $sth->execute;
1578 ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
1585 while (my @row = $sth->fetchrow_array) {
1587 push @values, $row[0];
1589 push @values, '<NULL>';
1597 my ($self, %alert) = @_;
1599 my @requiredFields = (
1604 my $result = _checkRequiredFields \@requiredFields, \%alert;
1606 return -1, "AddAlert: $result"
1609 return $self->_addRecord('alert', %alert);
1612 sub DeleteAlert($) {
1613 my ($self, $name) = @_;
1615 return $self->_deleteRecord('alert', "name='$name'");
1619 my ($self, $alert) = @_;
1623 my $condition = "name like '%$alert%'";
1625 return $self->_getRecords('alert', $condition);
1629 my ($self, $name) = @_;
1634 my @records = $self->_getRecords('alert', "name='$name'");
1637 return %{$records[0]};
1643 sub SendAlert($$$$$$$) {
1655 my $footing = '<hr><p style="text-align: center;">';
1656 $footing .= '<font color="#bbbbbb">';
1657 my $year = (localtime)[5] + 1900;
1658 $footing .= "<a href='$CLEAROPTS{CLEARADM_WEBBASE}'>Clearadm</a><br>";
1659 $footing .= "Copyright © $year, ClearSCM, Inc. - All rights reserved";
1661 my %alert = $self->GetAlert($alert);
1663 if ($alert{type} eq 'email') {
1664 my $from = 'Clearadm@' . hostdomain;
1669 subject => "Clearadm Alert: $system: $subject",
1672 footing => $footing,
1675 $self->Error("Don't know how to send $alert{type} alerts\n"
1676 . "Subject: $subject\n"
1677 . "Message: $message", 1);
1684 notification => $notification,
1685 runlog => $runlogID,
1686 timestamp => Today2SQLDatetime,
1687 message => $subject,
1690 return $self->AddAlertlog(%alertlog);
1693 sub GetLastAlert($$) {
1694 my ($self, $notification, $system) = @_;
1696 my $statement = <<"END";
1703 notification='$notification'
1704 and system='$system'
1711 my $sth = $self->{db}->prepare($statement)
1712 or return $self->_dberror('Unable to prepare statement', $statement);
1715 or return $self->_dberror('Unable to execute statement', $statement);
1717 my $alertlog= $sth->fetchrow_hashref;
1728 sub GetLastTaskFailure($$) {
1729 my ($self, $task, $system) = @_;
1731 my $statement = <<"END";
1740 and system='$system'
1748 my $sth = $self->{db}->prepare($statement)
1749 or return $self->_dberror('Unable to prepare statement', $statement);
1752 or return $self->_dberror('Unable to execute statement', $statement);
1754 my $runlog= $sth->fetchrow_hashref;
1758 if ($$runlog{ended}) {
1762 # If we didn't get any ended in the last call then there's nothing that
1763 # qualified. Still let's return a record (%runlog) that has a valid id so
1764 # that the caller can update that runlog with alerted = 'true'.
1765 $statement = <<"END";
1773 and system='$system'
1780 $sth = $self->{db}->prepare($statement)
1781 or return $self->_dberror('Unable to prepare statement', $statement);
1784 or return $self->_dberror('Unable to execute statement', $statement);
1786 $runlog = $sth->fetchrow_hashref;
1795 } # GetLastTaskFailure
1797 sub Notify($$$$$$) {
1809 $runlogID = $self->_getLastID
1814 # Update filesystem, if $filesystem was specified
1816 ($err, $msg) = $self->UpdateFilesystem(
1819 notification => $notification,
1823 $self->Error("Unable to set notification for filesystem $system:$filesystem "
1824 . "(Status: $err)\n$msg", $err) if $err;
1828 ($err, $msg) = $self->UpdateSystem(
1830 notification => $notification,
1834 my %notification = $self->GetNotification($notification);
1836 my %lastnotified = $self->GetLastAlert($notification, $system);
1838 if (%lastnotified and $lastnotified{timestamp}) {
1839 my $today = Today2SQLDatetime;
1840 my $lastnotified = $lastnotified{timestamp};
1842 if ($notification{nomorethan} =~ /hour/i) {
1843 $lastnotified = Add($lastnotified, (hours => 1));
1844 } elsif ($notification{nomorethan} =~ /day/i) {
1845 $lastnotified = Add($lastnotified, (days => 1));
1846 } elsif ($notification{nomorethan} =~ /week/i) {
1847 $lastnotified = Add($lastnotified, (days => 7));
1848 } elsif ($notification{nomorethan} =~ /month/i) {
1849 $lastnotified = Add($lastnotified, (month => 1));
1852 # If you want to fake an alert in the debugger just change $diff accordingly
1853 my $diff = Compare($today, $lastnotified);
1859 my $when = Today2SQLDatetime;
1860 my $nomorethan = lc $notification{nomorethan};
1861 my %alert = $self->GetAlert($notification{alert});
1862 my $to = $alert{who};
1864 # If $to is null then this means to send the alert to the admin for the
1868 my %system = $self->GetSystem($system);
1870 $to = $system{email};
1872 # If we don't know what system this error occurred on we'll have to notify
1873 # the "super user" defined as $self->{NOTIFY} (The receiver of last
1875 $to = $self->{NOTIFY};
1880 Error "To undefined";
1883 $message .= "<p>You will receive this alert no more than $nomorethan.</p>";
1885 ($err, $msg) = $self->SendAlert(
1886 $notification{alert},
1888 $notification{name},
1895 $self->Error("Unable to send alert (Status: $err)\n$msg", $err) if $err;
1897 verbose "Sent alert to $to";
1899 # Update runlog to indicate we notified the user for this execution
1900 ($err, $msg) = $self->UpdateRunlog(
1906 $self->Error("Unable to update runlog (Status: $err)\n$msg", $err) if $err;
1911 sub ClearNotifications($$;$) {
1912 my ($self, $system, $filesystem) = @_;
1917 ($err, $msg) = $self->UpdateFilesystem(
1919 $filesystem, (notification => undef),
1922 error "Unable to clear notification for filesystem $system:$filesystem "
1923 . "(Status: $err)\n$msg", $err
1926 # Check to see any of this system's filesystems have notifications. If none
1927 # then it's save to say we've turned off the last notification for a
1928 # filesystem involved with this system and if $system{notification} was
1929 # 'Filesystem' then we can toggle off the notification on the system too
1930 my $filesystemsAlerted = 0;
1932 for ($self->FindFilesystem($system)) {
1933 $filesystemsAlerted++
1934 if $$_{notification};
1937 my %system = $self->GetSystem($system);
1942 if ($system{notification} and
1943 $system{notification} eq 'Filesystem' and
1944 $filesystemsAlerted == 0) {
1945 ($err, $msg) = $self->UpdateSystem($system, (notification => undef));
1947 $self->Error("Unable to clear notification for system $system "
1948 . "(Status: $err)\n$msg", $err) if $err;
1951 ($err, $msg) = $self->UpdateSystem($system, (notification => undef));
1953 $self->Error("Unable to clear notification for system $system "
1954 . "(Status: $err)\n$msg", $err) if $err;
1958 } # ClearNotifications
1960 sub SystemAlive(%) {
1961 my ($self, %system) = @_;
1963 # If we've never heard from this system then we will assume that the system
1964 # has not been set up to run clearagent and has never checked in. In any event
1965 # we cannot say the system died because we've never known it to be alive!
1967 unless $system{lastheardfrom};
1969 # If a system is not active (may have been temporarily been deactivated) then
1970 # we don't want to turn on the bells and whistles alerting people it's down.
1972 if $system{active} eq 'false';
1974 my $today = Today2SQLDatetime;
1975 my $lastheardfrom = $system{lastheardfrom};
1977 my $tenMinutes = 10 * 60;
1979 $lastheardfrom = Add($lastheardfrom, (seconds => $tenMinutes));
1981 if (DateToEpoch($lastheardfrom) < DateToEpoch($today)) {
1982 $self->UpdateSystem(
1984 notification => 'Heartbeat'
1990 if ($system{notification}) {
1991 $self->UpdateSystem(
1993 notification => undef
2001 sub UpdateAlert($%) {
2002 my ($self, $name, %update) = @_;
2004 return $self->_updateRecord(
2011 sub AddAlertlog(%) {
2012 my ($self, %alertlog) = @_;
2014 my @requiredFields = (
2019 my $result = _checkRequiredFields \@requiredFields, \%alertlog;
2021 return -1, "AddAlertlog: $result"
2025 $alertlog{timestamp} = Today2SQLDatetime;
2027 return $self->_addRecord('alertlog', %alertlog);
2030 sub DeleteAlertlog($) {
2031 my ($self, $condition) = @_;
2036 if ($condition =~ /all/i) {
2037 return $self->_deleteRecord('alertlog');
2039 return $self->_deleteRecord('alertlog', $condition);
2043 sub FindAlertlog(;$$$$$) {
2044 my ($self, $alert, $system, $notification, $start, $page) = @_;
2048 $notification ||= '';
2050 my $condition = "alert like '%$alert%'";
2051 $condition .= ' and ';
2052 $condition .= "system like '%$system%'";
2053 $condition .= ' and ';
2054 $condition .= "notification like '%$notification%'";
2055 $condition .= " order by timestamp desc";
2057 if (defined $start) {
2059 $condition .= " limit $start, $page";
2062 return $self->_getRecords('alertlog', $condition);
2065 sub GetAlertlog($) {
2066 my ($self, $alert) = @_;
2071 my @records = $self->_getRecords('alertlog', "alert='$alert'");
2074 return %{$records[0]};
2080 sub UpdateAlertlog($%) {
2081 my ($self, $alert, %update) = @_;
2083 return $self->_updateRecord(
2090 sub AddNotification(%) {
2091 my ($self, %notification) = @_;
2093 my @requiredFields = (
2099 my $result = _checkRequiredFields \@requiredFields, \%notification;
2101 return -1, "AddNotification: $result"
2104 return $self->_addRecord('notification', %notification);
2107 sub DeleteNotification($) {
2108 my ($self, $name) = @_;
2110 return $self->_deleteRecord('notification', "name='$name'");
2113 sub FindNotification(;$$) {
2114 my ($self, $name, $cond, $ordering) = @_;
2118 my $condition = "name like '%$name%'";
2119 $condition .= " and $cond"
2122 return $self->_getRecords('notification', $condition);
2123 } # FindNotification
2125 sub GetNotification($) {
2126 my ($self, $name) = @_;
2131 my @records = $self->_getRecords('notification', "name='$name'");
2134 return %{$records[0]};
2140 sub UpdateNotification($%) {
2141 my ($self, $name, %update) = @_;
2143 return $self->_updateRecord(
2148 } # UpdateNotification
2150 sub AddVobStorage(%) {
2151 my ($self, %vobstorage) = @_;
2153 my @requiredFields = (
2157 my $result = _checkRequiredFields \@requiredFields, \%vobstorage;
2159 return -1, "AddVobStorage: $result" if $result;
2162 $vobstorage{timestamp} = Today2SQLDatetime;
2164 return $self->_addRecord('vobstorage', %vobstorage);
2167 sub AddViewStorage(%) {
2168 my ($self, %viewstorage) = @_;
2170 my @requiredFields = (
2174 my $result = _checkRequiredFields \@requiredFields, \%viewstorage;
2176 return -1, "AddViewStorage: $result" if $result;
2179 $viewstorage{timestamp} = Today2SQLDatetime;
2181 return $self->_addRecord('viewstorage', %viewstorage);
2188 =head1 CONFIGURATION AND ENVIRONMENT
2190 DEBUG: If set then $debug is set to this level.
2192 VERBOSE: If set then $verbose is set to this level.
2194 TRACE: If set then $trace is set to this level.
2206 L<Net::Domain|Net::Domain>
2208 =head2 ClearSCM Perl Modules
2222 <a href="http://clearscm.com/php/scm_man.php?file=lib/DateUtils.pm">DateUtils</a><br>
2223 <a href="http://clearscm.com/php/scm_man.php?file=lib/Display.pm">Display</a><br>
2224 <a href="http://clearscm.com/php/scm_man.php?file=lib/GetConfig.pm">GetConfig</a><br>
2225 <a href="http://clearscm.com/php/scm_man.php?file=lib/Mail.pm">Mail</a><br>
2230 =head1 BUGS AND LIMITATIONS
2232 There are no known bugs in this module
2234 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
2236 =head1 LICENSE AND COPYRIGHT
2238 Copyright (c) 2010, ClearSCM, Inc. All rights reserved.