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" if $result;
676 return $self->_addRecord('vob', %vob);
680 my ($self, $tag, $region) = @_;
682 return $self->_deleteRecord('vob', "tag='$tag' and region='$region'");
686 my ($self, $tag, $region) = @_;
690 # Windows vob tags begin with "\", which is problematic. The solution is to
694 my @records = $self->_getRecords('vob', "tag='$tag' and region='$region'");
697 return %{$records[0]};
704 my ($self, $tag, $region) = @_;
706 # Windows vob tags begin with "\", which is problematic. The solution is to
710 my $condition = "tag like '%$tag%'";
712 $condition .= " and region='$region'" if $region;
714 return $self->_getRecords('vob', $condition);
718 my ($self, %vob) = @_;
720 # Windows vob tags begin with "\", which is problematic. The solution is to
722 my $vobtag = $vob{tag};
724 $vobtag =~ s/^\\/\\\\/;
726 return $self->_updateRecord('vob', "tag='$vobtag' and region='$vob{region}'", %vob);
730 my ($self, %view) = @_;
732 my @requiredFields = (
737 my $result = _checkRequiredFields \@requiredFields, \%view;
739 return -1, "AddView: $result"
742 return $self->_addRecord('view', %view);
746 my ($self, $tag, $region) = @_;
748 return $self->_deleteRecord('vob', "tag='$tag' and region='$region'");
752 my ($self, %view) = @_;
754 return $self->_updateRecord('view', "tag='$view{tag}' and region='$view{region}'", %view);
758 my ($self, $tag, $region) = @_;
762 my @records = $self->_getRecords('view', "tag='$tag' and region='$region'");
765 return %{$records[0]};
771 sub FindView(;$$$$) {
772 my ($self, $system, $region, $tag, $ownerName) = @_;
781 $condition = "system like '%$system%'";
782 $condition .= ' and ';
783 $condition = "region like '%$region%'";
784 $condition .= ' and ';
785 $condition .= "tag like '%$tag'";
786 $condition .= ' and ';
787 $condition .= "ownerName like '%$ownerName'";
789 return $self->_getRecords('view', $condition);
793 my ($self, %fs) = @_;
795 my @requiredFields = (
800 my $result = _checkRequiredFields \@requiredFields, \%fs;
802 return -1, "AddFS: $result"
806 $fs{timestamp} = Today2SQLDatetime;
808 return $self->_addRecord('fs', %fs);
812 my ($self, $system, $filesystem) = @_;
814 my %filesystem = $self->GetFilesystem($system, $filesystem);
819 my %task = $self->GetTask('scrub');
821 $self->Error("Unable to find scrub task!", 1) unless %task;
824 my $today = Today2SQLDatetime;
826 # TODO: SubtractDays uses just an approximation (i.e. subtracting 30 days when
827 # in February is not right.
828 if ($filesystem{filesystemHist} =~ /(\d+) month/i) {
830 } elsif ($filesystem{filesystemHist} =~ /(\d+) year/i) {
834 my $oldage = SubtractDays $today, $days;
836 my ($dberr, $dbmsg) = $self->_deleteRecord(
838 "system='$system' and filesystem='$filesystem' and timestamp<='$oldage'"
841 if ($dbmsg eq 'Records deleted') {
847 $runlog{task} = $task{name};
848 $runlog{started} = $today;
851 "Scrubbed $dberr fs records for filesystem $system:$filesystem";
853 my ($err, $msg) = $self->AddRunlog(%runlog);
855 $self->Error("Unable to add runlog - (Error: $err)\n$msg") if $err;
858 return ($dberr, $dbmsg);
862 my ($self, $system) = @_;
864 my %system = $self->GetSystem($system);
869 my %task = $self->GetTask('loadavg');
871 $self->Error("Unable to find loadavg task!", 1) unless %task;
874 my $today = Today2SQLDatetime;
876 # TODO: SubtractDays uses just an approximation (i.e. subtracting 30 days when
877 # in February is not right.
878 if ($system{loadavgHist} =~ /(\d+) month/i) {
880 } elsif ($system{loadavgHist} =~ /(\d+) year/i) {
884 my $oldage = SubtractDays $today, $days;
886 my ($dberr, $dbmsg) = $self->_deleteRecord(
888 "system='$system' and timestamp<='$oldage'"
891 if ($dbmsg eq 'Records deleted') {
897 $runlog{task} = $task{name};
898 $runlog{started} = $today;
901 "Scrubbed $dberr loadavg records for system $system";
903 my ($err, $msg) = $self->AddRunlog(%runlog);
905 $self->Error("Unable to add runload (Error: $err)\n$msg") if $err;
908 return ($dberr, $dbmsg);
912 my ($self, $system, $filesystem, $start, $end, $count, $interval) = @_;
914 $system = $self->_aliasSystem($system);
922 $interval ||= 'Minute';
924 my $size = $interval =~ /month/i
926 : $interval =~ /day/i
928 : $interval =~ /hour/i
932 undef $start if $start and $start =~ /earliest/i;
933 undef $end if $end and $end =~ /latest/i;
935 my $condition = "system='$system' and filesystem='$filesystem'";
936 $condition .= " and timestamp>='$start'" if $start;
937 $condition .= " and timestamp<='$end'" if $end;
939 $condition .= " group by left(timestamp,$size)";
942 # We can't simply do a "limit 0, $count" as that just gets the front end of
943 # the records return (i.e. if $count = say 10 and the timestamp range
944 # returns 40 rows we'll see only rows 1-10, not rows 31-40). We need limit
945 # $offset, $count where $offset = the number of qualifying records minus
947 my $nbrRecs = $self->Count('fs', $condition);
948 my $offset = $nbrRecs - $count;
950 # Offsets of < 0 are not allowed.
954 $condition .= " limit $offset, $count";
957 my $statement = <<"END";
962 left(timestamp,$size) as timestamp,
974 my $sth = $self->{db}->prepare($statement);
977 ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
982 my $status = $sth->execute;
985 ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
992 while (my $row = $sth->fetchrow_hashref) {
999 sub GetLatestFS($$) {
1000 my ($self, $system, $filesystem) = @_;
1002 $system = $self->_aliasSystem($system);
1010 my @records = $self->_getRecords(
1012 "system='$system' and filesystem='$filesystem'"
1013 . " order by timestamp desc limit 0, 1",
1017 return %{$records[0]};
1024 my ($self, %loadavg) = @_;
1026 my @requiredFields = (
1030 my $result = _checkRequiredFields \@requiredFields, \%loadavg;
1032 return -1, "AddLoadavg: $result"
1036 $loadavg{timestamp} = Today2SQLDatetime;
1038 return $self->_addRecord('loadavg', %loadavg);
1041 sub GetLoadavg($;$$$$) {
1042 my ($self, $system, $start, $end, $count, $interval) = @_;
1044 $system = $self->_aliasSystem($system);
1049 $interval ||= 'Minute';
1051 my $size = $interval =~ /month/i
1053 : $interval =~ /day/i
1055 : $interval =~ /hour/i
1061 undef $start if $start and $start =~ /earliest/i;
1062 undef $end if $end and $end =~ /latest/i;
1064 $condition .= " system='$system'" if $system;
1065 $condition .= " and timestamp>='$start'" if $start;
1066 $condition .= " and timestamp<='$end'" if $end;
1068 $condition .= " group by left(timestamp,$size)";
1071 # We can't simply do a "limit 0, $count" as that just gets the front end of
1072 # the records return (i.e. if $count = say 10 and the timestamp range
1073 # returns 40 rows we'll see only rows 1-10, not rows 31-40). We need limit
1074 # $offset, $count where $offset = the number of qualifying records minus
1076 my $nbrRecs = $self->Count('loadavg', $condition);
1077 my $offset = $nbrRecs - $count;
1079 # Offsets of < 0 are not allowed.
1083 $condition .= " limit $offset, $count";
1086 my $statement = <<"END";
1089 left(timestamp,$size) as timestamp,
1092 avg(loadavg) as loadavg
1100 my $sth = $self->{db}->prepare($statement);
1103 ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
1108 my $status = $sth->execute;
1111 ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
1118 while (my $row = $sth->fetchrow_hashref) {
1119 push @records, $row;
1125 sub GetLatestLoadavg($) {
1126 my ($self, $system) = @_;
1128 $system = $self->_aliasSystem($system);
1133 my @records = $self->_getRecords(
1136 . " order by timestamp desc limit 0, 1",
1140 return %{$records[0]};
1144 } # GetLatestLoadavg
1146 sub GetStorage($$$;$$$$$) {
1147 my ($self, $type, $tag, $storage, $region, $start, $end, $count, $interval) = @_;
1149 $interval ||= 'Day';
1150 $region ||= $Clearcase::CC->region;
1152 return unless $type =~ /vob/i or $type =~ /view/;
1154 my $size = $interval =~ /month/i
1156 : $interval =~ /day/i
1158 : $interval =~ /hour/i
1162 undef $start if $start and $start =~ /earliest/i;
1163 undef $end if $end and $end =~ /latest/i;
1165 # Windows vob tags begin with "\", which is problematic. The solution is to
1167 $tag =~ s/^\\/\\\\/;
1170 my $table = $type eq 'vob' ? 'vobstorage' : 'viewstorage';
1172 $condition = "tag='$tag' and region='$region'";
1173 $condition .= " and timestamp>='$start'" if $start;
1174 $condition .= " and timestamp<='$end'" if $end;
1176 $condition .= " group by left(timestamp,$size)";
1179 # We can't simply do a "limit 0, $count" as that just gets the front end of
1180 # the records return (i.e. if $count = say 10 and the timestamp range
1181 # returns 40 rows we'll see only rows 1-10, not rows 31-40). We need limit
1182 # $offset, $count where $offset = the number of qualifying records minus
1184 my $nbrRecs = $self->Count($table, $condition);
1185 my $offset = $nbrRecs - $count;
1187 # Offsets of < 0 are not allowed.
1188 $offset = 0 if $offset < 0;
1190 $condition .= " limit $offset, $count";
1193 my $statement = <<"END";
1197 left(timestamp,$size) as timestamp,
1198 avg($storage) as size
1206 my $sth = $self->{db}->prepare($statement);
1209 ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
1214 my $status = $sth->execute;
1217 ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
1224 while (my $row = $sth->fetchrow_hashref) {
1225 push @records, $row;
1232 my ($self, %task) = @_;
1234 my @requiredFields = (
1239 my $result = _checkRequiredFields \@requiredFields, \%task;
1241 return -1, "AddTask: $result"
1244 return $self->_addRecord('task', %task);
1248 my ($self, $name) = @_;
1250 return $self->_deleteRecord('task', "name='$name'");
1254 my ($self, $name) = @_;
1258 my $condition = "name like '%$name%'";
1260 return $self->_getRecords('task', $condition);
1264 my ($self, $name) = @_;
1269 my @records = $self->_getRecords('task', "name='$name'");
1272 return %{$records[0]};
1278 sub UpdateTask($%) {
1279 my ($self, $name, %update) = @_;
1281 return $self->_updateRecord('task', "name='$name'", %update);
1284 sub AddSchedule(%) {
1285 my ($self, %schedule) = @_;
1287 my @requiredFields = (
1291 my $result = _checkRequiredFields \@requiredFields, \%schedule;
1293 return -1, "AddSchedule: $result"
1296 return $self->_addRecord('schedule', %schedule);
1299 sub DeleteSchedule($) {
1300 my ($self, $name) = @_;
1302 return $self->_deleteRecord('schedule', "name='$name'");
1305 sub FindSchedule(;$$) {
1306 my ($self, $name, $task) = @_;
1311 my $condition = "name like '%$name%'";
1312 $condition .= ' and ';
1313 $condition .= "task like '%$task%'";
1315 return $self->_getRecords('schedule', $condition);
1318 sub GetSchedule($) {
1319 my ($self, $name) = @_;
1321 my @records = $self->_getRecords('schedule', "name='$name'");
1324 return %{$records[0]};
1330 sub UpdateSchedule($%) {
1331 my ($self, $name, %update) = @_;
1333 return $self->_updateRecord('schedule', "name='$name'", %update);
1337 my ($self, %runlog) = @_;
1339 my @requiredFields = (
1343 my $result = _checkRequiredFields \@requiredFields, \%runlog;
1345 return -1, "AddRunlog: $result"
1348 $runlog{ended} = Today2SQLDatetime;
1350 $runlog{system} = hostname if $runlog{system} =~ /localhost/i;
1352 my ($err, $msg) = $self->_addRecord('runlog', %runlog);
1354 return ($err, $msg, $self->_getLastID);
1357 sub DeleteRunlog($) {
1358 my ($self, $condition) = @_;
1360 return $self->_deleteRecord('runlog', $condition);
1363 sub FindRunlog(;$$$$$$) {
1364 my ($self, $task, $system, $status, $id, $start, $page) = @_;
1366 # If ID is specified then that's all that really matters as it uniquely
1367 # identifies a runlog entry;
1368 my ($condition, $conditions);
1372 if ($task !~ /all/i) {
1374 $condition = "task like '%$task%'";
1377 if ($system !~ /all/i) {
1378 $condition .= ' and ' if $conditions;
1379 $condition .= "system like '%$system%'";
1384 $condition .= ' and ' if $conditions;
1386 if ($status =~ /!(-*\d+)/) {
1387 $condition .= "status<>$1";
1389 $condition .= "status=$status"
1393 # Need defined here as $start may be 0!
1394 if (defined $start) {
1396 $limit = "limit $start, $page";
1399 $condition = "id=$id";
1402 return $self->_getRecords('runlog', $condition, " order by started desc $limit");
1406 my ($self, $id) = @_;
1411 my @records = $self->_getRecords('runlog', "id=$id");
1414 return %{$records[0]};
1420 sub UpdateRunlog($%) {
1421 my ($self, $id, %update) = @_;
1423 return $self->_updateRecord('runlog', "id=$id", %update);
1427 my ($self, $table, $condition) = @_;
1429 $condition = $condition ? 'where ' . $condition : '';
1433 my $statement = "select count(*) from $table $condition";
1435 my $sth = $self->{db}->prepare($statement);
1438 ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
1443 my $status = $sth->execute;
1446 ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
1451 # Hack! Statements such as the following:
1453 # select count(*) from fs where system='jupiter' and filesystem='/dev/sdb5'
1454 # > group by left(timestamp,10);
1466 # 7 rows in set (0.00 sec)
1468 # Here we want 7 but what we see in $records[0] is 49. So the hack is that if
1469 # statement contains "group by" then we assume we have the above and return
1470 # scalar @records, otherwise we return $records[0];
1471 if ($statement =~ /group by/i) {
1472 my $allrows = $sth->fetchall_arrayref;
1474 return scalar @{$allrows};
1476 my @records = $sth->fetchrow_array;
1482 # GetWork returns two items, the number of seconds to wait before the next task
1483 # and array of hash records of work to be done immediately. The caller should
1484 # execute the work to be done, timing it, and subtracting it from the $sleep
1485 # time returned. If the caller exhausts the $sleep time then they should call
1492 my $statement = <<"END";
1494 schedule.name as schedulename,
1496 task.system as system,
1498 schedule.notification,
1500 runlog.started as lastrun
1503 schedule left join runlog on schedule.lastrunid=runlog.id
1505 schedule.task=task.name
1506 and schedule.active='true'
1510 my $sth = $self->{db}->prepare($statement);
1513 ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
1518 my $status = $sth->execute;
1521 ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
1529 while (my $row = $sth->fetchrow_hashref) {
1530 if ($$row{system} !~ /localhost/i) {
1531 my %system = $self->GetSystem($$row{system});
1533 # Skip inactive systems
1534 next if $system{active} eq 'false';
1537 # If started is not defined then this task was never run so run it now.
1538 unless ($$row{lastrun}) {
1539 push @records, $row;
1543 # TODO: Handle frequencies better.
1546 if ($$row{frequency} =~ /(\d+) seconds/i) {
1548 } elsif ($$row{frequency} =~ /(\d+) minute/i) {
1550 } elsif ($$row{frequency} =~ /(\d+) hour/i) {
1551 $seconds = $1 * 60 * 60;
1552 } elsif ($$row{frequency} =~ /(\d+) day/i) {
1553 $seconds= $1 * 60 * 60 * 24;
1555 warning "Don't know how to handle frequencies like $$row{frequency}";
1559 my $today = Today2SQLDatetime;
1560 my $lastrun = Add($$row{lastrun}, (seconds => $seconds));
1561 my $waitTime = DateToEpoch($lastrun) - DateToEpoch($today);
1563 if ($waitTime < 0) {
1564 # We're late - push this onto records and move on
1565 push @records, $row;
1568 $sleep ||= $waitTime;
1570 if ($sleep > $waitTime) {
1575 # Even if there is nothing to do the caller should sleep a bit and come back
1576 # to us. So if it ends up there's nothing past due, and nothing upcoming, then
1577 # sleep for a minute and return here. Somebody may have added a new task next
1578 # time we're called.
1579 if (@records == 0 and not $sleep) {
1583 return ($sleep, @records);
1586 sub GetUniqueList($$) {
1587 my ($self, $table, $field) = @_;
1591 my $statement = "select $field from $table group by $field";
1593 my $sth = $self->{db}->prepare($statement);
1596 ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
1601 my $status = $sth->execute;
1604 ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
1611 while (my @row = $sth->fetchrow_array) {
1613 push @values, $row[0];
1615 push @values, '<NULL>';
1623 my ($self, %alert) = @_;
1625 my @requiredFields = (
1630 my $result = _checkRequiredFields \@requiredFields, \%alert;
1632 return -1, "AddAlert: $result"
1635 return $self->_addRecord('alert', %alert);
1638 sub DeleteAlert($) {
1639 my ($self, $name) = @_;
1641 return $self->_deleteRecord('alert', "name='$name'");
1645 my ($self, $alert) = @_;
1649 my $condition = "name like '%$alert%'";
1651 return $self->_getRecords('alert', $condition);
1655 my ($self, $name) = @_;
1660 my @records = $self->_getRecords('alert', "name='$name'");
1663 return %{$records[0]};
1669 sub SendAlert($$$$$$$) {
1681 my $footing = '<hr><p style="text-align: center;">';
1682 $footing .= '<font color="#bbbbbb">';
1683 my $year = (localtime)[5] + 1900;
1684 $footing .= "<a href='$CLEAROPTS{CLEARADM_WEBBASE}'>Clearadm</a><br>";
1685 $footing .= "Copyright © $year, ClearSCM, Inc. - All rights reserved";
1687 my %alert = $self->GetAlert($alert);
1689 if ($alert{type} eq 'email') {
1690 my $from = 'Clearadm@' . hostdomain;
1695 subject => "Clearadm Alert: $system: $subject",
1698 footing => $footing,
1701 $self->Error("Don't know how to send $alert{type} alerts\n"
1702 . "Subject: $subject\n"
1703 . "Message: $message", 1);
1710 notification => $notification,
1711 runlog => $runlogID,
1712 timestamp => Today2SQLDatetime,
1713 message => $subject,
1716 return $self->AddAlertlog(%alertlog);
1719 sub GetLastAlert($$) {
1720 my ($self, $notification, $system) = @_;
1722 my $statement = <<"END";
1729 notification='$notification'
1730 and system='$system'
1737 my $sth = $self->{db}->prepare($statement)
1738 or return $self->_dberror('Unable to prepare statement', $statement);
1741 or return $self->_dberror('Unable to execute statement', $statement);
1743 my $alertlog= $sth->fetchrow_hashref;
1754 sub GetLastTaskFailure($$) {
1755 my ($self, $task, $system) = @_;
1757 my $statement = <<"END";
1766 and system='$system'
1774 my $sth = $self->{db}->prepare($statement)
1775 or return $self->_dberror('Unable to prepare statement', $statement);
1778 or return $self->_dberror('Unable to execute statement', $statement);
1780 my $runlog= $sth->fetchrow_hashref;
1784 if ($$runlog{ended}) {
1788 # If we didn't get any ended in the last call then there's nothing that
1789 # qualified. Still let's return a record (%runlog) that has a valid id so
1790 # that the caller can update that runlog with alerted = 'true'.
1791 $statement = <<"END";
1799 and system='$system'
1806 $sth = $self->{db}->prepare($statement)
1807 or return $self->_dberror('Unable to prepare statement', $statement);
1810 or return $self->_dberror('Unable to execute statement', $statement);
1812 $runlog = $sth->fetchrow_hashref;
1821 } # GetLastTaskFailure
1823 sub Notify($$$$$$) {
1835 $runlogID = $self->_getLastID
1840 # Update filesystem, if $filesystem was specified
1842 ($err, $msg) = $self->UpdateFilesystem(
1845 notification => $notification,
1849 $self->Error("Unable to set notification for filesystem $system:$filesystem "
1850 . "(Status: $err)\n$msg", $err) if $err;
1854 ($err, $msg) = $self->UpdateSystem(
1856 notification => $notification,
1860 my %notification = $self->GetNotification($notification);
1862 my %lastnotified = $self->GetLastAlert($notification, $system);
1864 if (%lastnotified and $lastnotified{timestamp}) {
1865 my $today = Today2SQLDatetime;
1866 my $lastnotified = $lastnotified{timestamp};
1868 if ($notification{nomorethan} =~ /hour/i) {
1869 $lastnotified = Add($lastnotified, (hours => 1));
1870 } elsif ($notification{nomorethan} =~ /day/i) {
1871 $lastnotified = Add($lastnotified, (days => 1));
1872 } elsif ($notification{nomorethan} =~ /week/i) {
1873 $lastnotified = Add($lastnotified, (days => 7));
1874 } elsif ($notification{nomorethan} =~ /month/i) {
1875 $lastnotified = Add($lastnotified, (month => 1));
1878 # If you want to fake an alert in the debugger just change $diff accordingly
1879 my $diff = Compare($today, $lastnotified);
1885 my $when = Today2SQLDatetime;
1886 my $nomorethan = lc $notification{nomorethan};
1887 my %alert = $self->GetAlert($notification{alert});
1888 my $to = $alert{who};
1890 # If $to is null then this means to send the alert to the admin for the
1894 my %system = $self->GetSystem($system);
1896 $to = $system{email};
1898 # If we don't know what system this error occurred on we'll have to notify
1899 # the "super user" defined as $self->{NOTIFY} (The receiver of last
1901 $to = $self->{NOTIFY};
1906 Error "To undefined";
1909 $message .= "<p>You will receive this alert no more than $nomorethan.</p>";
1911 ($err, $msg) = $self->SendAlert(
1912 $notification{alert},
1914 $notification{name},
1921 $self->Error("Unable to send alert (Status: $err)\n$msg", $err) if $err;
1923 verbose "Sent alert to $to";
1925 # Update runlog to indicate we notified the user for this execution
1926 ($err, $msg) = $self->UpdateRunlog(
1932 $self->Error("Unable to update runlog (Status: $err)\n$msg", $err) if $err;
1937 sub ClearNotifications($$;$) {
1938 my ($self, $system, $filesystem) = @_;
1943 ($err, $msg) = $self->UpdateFilesystem(
1945 $filesystem, (notification => undef),
1948 error "Unable to clear notification for filesystem $system:$filesystem "
1949 . "(Status: $err)\n$msg", $err
1952 # Check to see any of this system's filesystems have notifications. If none
1953 # then it's save to say we've turned off the last notification for a
1954 # filesystem involved with this system and if $system{notification} was
1955 # 'Filesystem' then we can toggle off the notification on the system too
1956 my $filesystemsAlerted = 0;
1958 for ($self->FindFilesystem($system)) {
1959 $filesystemsAlerted++
1960 if $$_{notification};
1963 my %system = $self->GetSystem($system);
1968 if ($system{notification} and
1969 $system{notification} eq 'Filesystem' and
1970 $filesystemsAlerted == 0) {
1971 ($err, $msg) = $self->UpdateSystem($system, (notification => undef));
1973 $self->Error("Unable to clear notification for system $system "
1974 . "(Status: $err)\n$msg", $err) if $err;
1977 ($err, $msg) = $self->UpdateSystem($system, (notification => undef));
1979 $self->Error("Unable to clear notification for system $system "
1980 . "(Status: $err)\n$msg", $err) if $err;
1984 } # ClearNotifications
1986 sub SystemAlive(%) {
1987 my ($self, %system) = @_;
1989 # If we've never heard from this system then we will assume that the system
1990 # has not been set up to run clearagent and has never checked in. In any event
1991 # we cannot say the system died because we've never known it to be alive!
1993 unless $system{lastheardfrom};
1995 # If a system is not active (may have been temporarily been deactivated) then
1996 # we don't want to turn on the bells and whistles alerting people it's down.
1998 if $system{active} eq 'false';
2000 my $today = Today2SQLDatetime;
2001 my $lastheardfrom = $system{lastheardfrom};
2003 my $tenMinutes = 10 * 60;
2005 $lastheardfrom = Add($lastheardfrom, (seconds => $tenMinutes));
2007 if (DateToEpoch($lastheardfrom) < DateToEpoch($today)) {
2008 $self->UpdateSystem(
2010 notification => 'Heartbeat'
2016 if ($system{notification}) {
2017 $self->UpdateSystem(
2019 notification => undef
2027 sub UpdateAlert($%) {
2028 my ($self, $name, %update) = @_;
2030 return $self->_updateRecord(
2037 sub AddAlertlog(%) {
2038 my ($self, %alertlog) = @_;
2040 my @requiredFields = (
2045 my $result = _checkRequiredFields \@requiredFields, \%alertlog;
2047 return -1, "AddAlertlog: $result"
2051 $alertlog{timestamp} = Today2SQLDatetime;
2053 return $self->_addRecord('alertlog', %alertlog);
2056 sub DeleteAlertlog($) {
2057 my ($self, $condition) = @_;
2062 if ($condition =~ /all/i) {
2063 return $self->_deleteRecord('alertlog');
2065 return $self->_deleteRecord('alertlog', $condition);
2069 sub FindAlertlog(;$$$$$) {
2070 my ($self, $alert, $system, $notification, $start, $page) = @_;
2074 $notification ||= '';
2076 my $condition = "alert like '%$alert%'";
2077 $condition .= ' and ';
2078 $condition .= "system like '%$system%'";
2079 $condition .= ' and ';
2080 $condition .= "notification like '%$notification%'";
2081 $condition .= " order by timestamp desc";
2083 if (defined $start) {
2085 $condition .= " limit $start, $page";
2088 return $self->_getRecords('alertlog', $condition);
2091 sub GetAlertlog($) {
2092 my ($self, $alert) = @_;
2097 my @records = $self->_getRecords('alertlog', "alert='$alert'");
2100 return %{$records[0]};
2106 sub UpdateAlertlog($%) {
2107 my ($self, $alert, %update) = @_;
2109 return $self->_updateRecord(
2116 sub AddNotification(%) {
2117 my ($self, %notification) = @_;
2119 my @requiredFields = (
2125 my $result = _checkRequiredFields \@requiredFields, \%notification;
2127 return -1, "AddNotification: $result"
2130 return $self->_addRecord('notification', %notification);
2133 sub DeleteNotification($) {
2134 my ($self, $name) = @_;
2136 return $self->_deleteRecord('notification', "name='$name'");
2139 sub FindNotification(;$$) {
2140 my ($self, $name, $cond, $ordering) = @_;
2144 my $condition = "name like '%$name%'";
2145 $condition .= " and $cond"
2148 return $self->_getRecords('notification', $condition);
2149 } # FindNotification
2151 sub GetNotification($) {
2152 my ($self, $name) = @_;
2157 my @records = $self->_getRecords('notification', "name='$name'");
2160 return %{$records[0]};
2166 sub UpdateNotification($%) {
2167 my ($self, $name, %update) = @_;
2169 return $self->_updateRecord(
2174 } # UpdateNotification
2176 sub AddVobStorage(%) {
2177 my ($self, %vobstorage) = @_;
2179 my @requiredFields = (
2183 my $result = _checkRequiredFields \@requiredFields, \%vobstorage;
2185 return -1, "AddVobStorage: $result" if $result;
2188 $vobstorage{timestamp} = Today2SQLDatetime;
2190 return $self->_addRecord('vobstorage', %vobstorage);
2193 sub AddViewStorage(%) {
2194 my ($self, %viewstorage) = @_;
2196 my @requiredFields = (
2200 my $result = _checkRequiredFields \@requiredFields, \%viewstorage;
2202 return -1, "AddViewStorage: $result" if $result;
2205 $viewstorage{timestamp} = Today2SQLDatetime;
2207 return $self->_addRecord('viewstorage', %viewstorage);
2214 =head1 CONFIGURATION AND ENVIRONMENT
2216 DEBUG: If set then $debug is set to this level.
2218 VERBOSE: If set then $verbose is set to this level.
2220 TRACE: If set then $trace is set to this level.
2232 L<Net::Domain|Net::Domain>
2234 =head2 ClearSCM Perl Modules
2248 <a href="http://clearscm.com/php/scm_man.php?file=lib/DateUtils.pm">DateUtils</a><br>
2249 <a href="http://clearscm.com/php/scm_man.php?file=lib/Display.pm">Display</a><br>
2250 <a href="http://clearscm.com/php/scm_man.php?file=lib/GetConfig.pm">GetConfig</a><br>
2251 <a href="http://clearscm.com/php/scm_man.php?file=lib/Mail.pm">Mail</a><br>
2256 =head1 BUGS AND LIMITATIONS
2258 There are no known bugs in this module
2260 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
2262 =head1 LICENSE AND COPYRIGHT
2264 Copyright (c) 2010, ClearSCM, Inc. All rights reserved.