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";
104 my $conf = dirname(__FILE__) . '/../etc/clearadm.conf';
106 our %CLEAROPTS = GetConfig($conf);
109 our $VERSION = '$Revision: 1.54 $';
110 ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
112 $CLEAROPTS{CLEARADM_USERNAME} = $ENV{CLEARADM_USERNAME}
113 ? $ENV{CLEARADM_USERNAME}
114 : $CLEAROPTS{CLEARADM_USERNAME}
115 ? $CLEAROPTS{CLEARADM_USERNAME}
117 $CLEAROPTS{CLEARADM_PASSWORD} = $ENV{CLEARADM_PASSWORD}
118 ? $ENV{CLEARADM_PASSWORD}
119 : $CLEAROPTS{CLEARADM_PASSWORD}
120 ? $CLEAROPTS{CLEARADM_PASSWORD}
122 $CLEAROPTS{CLEARADM_SERVER} = $ENV{CLEARADM_SERVER}
123 ? $ENV{CLEARADM_SERVER}
124 : $CLEAROPTS{CLEARADM_SERVER}
125 ? $CLEAROPTS{CLEARADM_SERVER}
128 my $defaultFilesystemThreshold = 90;
129 my $defaultFilesystemHist = '6 months';
130 my $defaultLoadavgHist = '6 months';
134 my ($self, $msg, $statement) = @_;
136 my $dberr = $self->{db}->err;
137 my $dberrmsg = $self->{db}->errstr;
140 $dberrmsg ||= 'Success';
145 my $function = (caller(1)) [3];
147 $message = "$function: $msg\nError #$dberr: $dberrmsg\n"
148 . "SQL Statement: $statement";
151 return $dberr, $message;
154 sub _formatValues(@) {
155 my ($self, @values) = @_;
160 push @returnValues, $_ eq '' ? 'null' : $self->{db}->quote($_) for (@values);
162 return @returnValues;
165 sub _formatNameValues(%) {
166 my ($self, %rec) = @_;
170 push @nameValueStrs, "$_=" . $self->{db}->quote($rec{$_}) for (keys %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" if $condition;
199 my $sth = $self->{db}->prepare($statement)
200 or return $self->_dberror('Unable to prepare statement', $statement);
203 or return $self->_dberror('Unable to execute statement', $statement);
205 my @row = $sth->fetchrow_array;
215 return ($count, 'Records deleted') if $count == 0;
217 $statement = "delete from $table ";
218 $statement .= "where $condition" if $condition;
220 $self->{db}->do($statement);
222 if ($self->{db}->err) {
223 return $self->_dberror("Unable to delete record from $table", $statement);
225 return $count, 'Records deleted';
229 sub _updateRecord($$%) {
230 my ($self, $table, $condition, %rec) = @_;
232 my $statement = "update $table set ";
233 $statement .= join ',', $self->_formatNameValues(%rec);
234 $statement .= " where $condition" if $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 for my $fieldname (@$fields) {
248 if ($fieldname eq $_) {
254 return "$fieldname is required" unless $found;
258 } # _checkRequiredFields
260 sub _getRecords($$;$) {
261 my ($self, $table, $condition, $additional) = @_;
267 my $statement = "select * from $table";
268 $statement .= " where $condition" if $condition;
269 $statement .= $additional;
271 my $sth = $self->{db}->prepare($statement);
274 ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
284 # We've been having the server going away. Supposedly it should reconnect so
285 # here we simply retry up to $maxAttempts times to re-execute the statement.
286 # (Are there other places where we need to do this?)
289 while ($err == 2006 and $attempts++ < $maxAttempts) {
290 $status = $sth->execute;
296 ($err, $msg) = $self->_dberror('Unable to execute statement',
302 croak $msg unless $err == 2006;
304 my $timestamp = YMDHMS;
306 $self->Error("$timestamp: Unable to talk to DB server.\n\n$msg\n\n"
307 . "Will try again in $sleepTime seconds", -1);
310 $self->_connect($self->{dbserver});
315 $self->Error("After $maxAttempts attempts I could not connect to the database", $err)
316 if ($err == 2006 and $attempts > $maxAttempts);
320 while (my $row = $sth->fetchrow_hashref) {
327 sub _aliasSystem($) {
328 my ($self, $system) = @_;
330 my %system = $self->GetSystem($system);
333 return $system{name};
342 my $statement = 'select last_insert_id()';
344 my $sth = $self->{db}->prepare($statement);
349 ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
354 my $status = $sth->execute;
357 ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
364 my @row = $sth->fetchrow_array;
370 my ($self, $dbserver) = @_;
372 $dbserver ||= $CLEAROPTS{CLEARADM_SERVER};
374 my $dbname = 'clearadm';
375 my $dbdriver = 'mysql';
377 $self->{db} = DBI->connect(
378 "DBI:$dbdriver:$dbname:$dbserver",
379 $CLEAROPTS{CLEARADM_USERNAME},
380 $CLEAROPTS{CLEARADM_PASSWORD},
383 "Couldn't connect to $dbname database "
384 . "as $CLEAROPTS{CLEARADM_USERNAME}\@$CLEAROPTS{CLEARADM_SERVER}"
387 $self->{dbserver} = $dbserver;
393 my ($class, $dbserver) = @_;
395 my $self = bless {}, $class;
397 $self->_connect($dbserver);
405 $self->{NOTIFY} = $CLEAROPTS{CLEARADM_NOTIFY};
411 my ($self, $msg, $errno) = @_;
413 # If $errno is specified we need to stop. However we need to notify somebody
414 # that cleartasks is no longer running.
418 if ($self->{NOTIFY}) {
420 to => $self->{NOTIFY},
421 subject => 'Internal error occurred in Clearadm',
422 data => "<p>An unexpected, internal error occurred in Clearadm:</p><p>$msg</p>",
426 exit $errno if $errno > 0;
434 my ($self, %system) = @_;
436 my @requiredFields = (
440 my $result = _checkRequiredFields \@requiredFields, \%system;
442 return -1, "AddSystem: $result" if $result;
444 $system{loadavgHist} ||= $defaultLoadavgHist;
446 return $self->_addRecord('system', %system);
449 sub DeleteSystem($) {
450 my ($self, $name) = @_;
452 return $self->_deleteRecord('system', "name='$name'");
455 sub UpdateSystem ($%) {
456 my ($self, $name, %update) = @_;
458 return $self->_updateRecord('system', "name='$name'", %update);
462 my ($self, $system) = @_;
464 return unless $system;
466 my @records = $self->_getRecords(
468 "name='$system' or alias like '%$system%'"
472 return %{$records[0]};
479 my ($self, $system) = @_;
483 my $condition = "name like '%$system%' or alias like '%$system%'";
485 return $self->_getRecords('system', $condition);
488 sub SearchSystem(;$) {
\r
489 my ($self, $condition) = @_;
491 $condition = "name like '%'" unless $condition;
493 return $self->_getRecords('system', $condition);
\r
497 my ($self, %package) = @_;
499 my @requiredFields = (
505 my $result = _checkRequiredFields \@requiredFields, \%package;
507 return -1, "AddPackage: $result" if $result;
509 return $self->_addRecord('package', %package);
512 sub DeletePackage($$) {
513 my ($self, $system, $name) = @_;
515 return $self->_deleteRecord(
517 "(system='$system' or alias='$system') and name='$name'");
520 sub UpdatePackage($$%) {
521 my ($self, $system, $name, %update) = @_;
523 $system = $self->_aliasSystem($system);
525 return unless $system;
527 return $self->_updateRecord('package', "system='$system'", %update);
531 my ($self, $system, $name) = @_;
533 $system = $self->_aliasSystem($system);
535 return unless $system;
538 my @records = $self->_getRecords(
540 "system='$system' and name='$name'"
544 return %{$records[0]};
550 sub FindPackage($;$) {
551 my ($self, $system, $name) = @_;
555 $system = $self->_aliasSystem($system);
557 return unless $system;
559 my $condition = "system='$system' and name like '%$name%'";
561 return $self->_getRecords('package', $condition);
564 sub AddFilesystem(%) {
565 my ($self, %filesystem) = @_;
567 my @requiredFields = (
573 my $result = _checkRequiredFields \@requiredFields, \%filesystem;
575 return -1, "AddFilesystem: $result" if $result;
577 # Default filesystem threshold
578 $filesystem{threshold} ||= $defaultFilesystemThreshold;
580 return $self->_addRecord('filesystem', %filesystem);
583 sub DeleteFilesystem($$) {
584 my ($self, $system, $filesystem) = @_;
586 $system = $self->_aliasSystem($system);
588 return unless $system;
590 return $self->_deleteRecord(
592 "system='$system' and filesystem='$filesystem'"
596 sub UpdateFilesystem($$%) {
597 my ($self, $system, $filesystem, %update) = @_;
599 $system = $self->_aliasSystem($system);
601 return unless $system;
603 return $self->_updateRecord(
605 "system='$system' and filesystem='$filesystem'",
610 sub GetFilesystem($$) {
611 my ($self, $system, $filesystem) = @_;
613 $system = $self->_aliasSystem($system);
615 return unless $system;
616 return unless $filesystem;
618 my @records = $self->_getRecords(
620 "system='$system' and filesystem='$filesystem'"
624 return %{$records[0]};
630 sub FindFilesystem($;$) {
631 my ($self, $system, $filesystem) = @_;
635 $system = $self->_aliasSystem($system);
637 return unless $system;
639 my $condition = "system='$system' and filesystem like '%$filesystem%'";
641 return $self->_getRecords('filesystem', $condition);
645 my ($self, %vob) = @_;
647 my @requiredFields = (
652 my $result = _checkRequiredFields \@requiredFields, \%vob;
654 return -1, "AddVob: $result" if $result;
656 return $self->_addRecord('vob', %vob);
660 my ($self, $tag, $region) = @_;
662 return $self->_deleteRecord('vob', "tag='$tag' and region='$region'");
666 my ($self, $tag, $region) = @_;
670 # Windows vob tags begin with "\", which is problematic. The solution is to
674 my @records = $self->_getRecords('vob', "tag='$tag' and region='$region'");
677 return %{$records[0]};
684 sub FindVobStorage(;$$) {
685 my ($self, $tag, $region) = @_;
692 my ($self, $tag, $region) = @_;
694 # Windows vob tags begin with "\", which is problematic. The solution is to
698 my $condition = "tag like '%$tag%'";
700 $condition .= " and region='$region'" if $region;
702 return $self->_getRecords('vobstorage', $condition);
706 my ($self, $tag, $region) = @_;
711 # Windows vob tags begin with "\", which is problematic. The solution is to
715 my $condition = "tag like '%$tag%'";
717 $condition .= " and region='$region'" if $region;
719 return $self->_getRecords('vob', $condition);
723 my ($self, %vob) = @_;
725 # Windows vob tags begin with "\", which is problematic. The solution is to
727 my $vobtag = $vob{tag};
729 $vobtag =~ s/^\\/\\\\/;
731 return $self->_updateRecord('vob', "tag='$vobtag' and region='$vob{region}'", %vob);
735 my ($self, %view) = @_;
737 my @requiredFields = (
742 my $result = _checkRequiredFields \@requiredFields, \%view;
744 return -1, "AddView: $result" if $result;
746 return $self->_addRecord('view', %view);
750 my ($self, $tag, $region) = @_;
752 return $self->_deleteRecord('vob', "tag='$tag' and region='$region'");
756 my ($self, %view) = @_;
758 return $self->_updateRecord('view', "tag='$view{tag}' and region='$view{region}'", %view);
762 my ($self, $tag, $region) = @_;
766 my @records = $self->_getRecords('view', "tag='$tag' and region='$region'");
769 return %{$records[0]};
775 sub FindView(;$$$$) {
776 my ($self, $tag, $region, $ownerName) = @_;
781 push @conditions, "tag like '%$tag%'" if $tag;
782 push @conditions, "region = '$region'" if $region;
783 push @conditions, "ownerName like '$ownerName'" if $ownerName;
785 $condition = join " and ", @conditions if @conditions;
787 return $self->_getRecords('view', $condition);
791 my ($self, %fs) = @_;
793 my @requiredFields = (
798 my $result = _checkRequiredFields \@requiredFields, \%fs;
800 return -1, "AddFS: $result"
804 $fs{timestamp} = Today2SQLDatetime;
806 return $self->_addRecord('fs', %fs);
810 my ($self, $system, $filesystem) = @_;
812 my %filesystem = $self->GetFilesystem($system, $filesystem);
814 return unless %filesystem;
816 my %task = $self->GetTask('scrub');
818 $self->Error("Unable to find scrub task!", 1) unless %task;
821 my $today = Today2SQLDatetime;
823 # TODO: SubtractDays uses just an approximation (i.e. subtracting 30 days when
824 # in February is not right.
825 if ($filesystem{filesystemHist} =~ /(\d+) month/i) {
827 } elsif ($filesystem{filesystemHist} =~ /(\d+) year/i) {
831 my $oldage = SubtractDays $today, $days;
833 my ($dberr, $dbmsg) = $self->_deleteRecord(
835 "system='$system' and filesystem='$filesystem' and timestamp<='$oldage'"
838 if ($dbmsg eq 'Records deleted') {
839 return (0, $dbmsg) if $dberr == 0;
843 $runlog{task} = $task{name};
844 $runlog{started} = $today;
847 "Scrubbed $dberr fs records for filesystem $system:$filesystem";
849 my ($err, $msg) = $self->AddRunlog(%runlog);
851 $self->Error("Unable to add runlog - (Error: $err)\n$msg") if $err;
854 return ($dberr, $dbmsg);
858 my ($self, $system) = @_;
860 my %system = $self->GetSystem($system);
862 return unless %system;
864 my %task = $self->GetTask('loadavg');
866 $self->Error("Unable to find loadavg task!", 1) unless %task;
869 my $today = Today2SQLDatetime;
871 # TODO: SubtractDays uses just an approximation (i.e. subtracting 30 days when
872 # in February is not right.
873 if ($system{loadavgHist} =~ /(\d+) month/i) {
875 } elsif ($system{loadavgHist} =~ /(\d+) year/i) {
879 my $oldage = SubtractDays $today, $days;
881 my ($dberr, $dbmsg) = $self->_deleteRecord(
883 "system='$system' and timestamp<='$oldage'"
886 if ($dbmsg eq 'Records deleted') {
887 return (0, $dbmsg) if $dberr == 0;
891 $runlog{task} = $task{name};
892 $runlog{started} = $today;
895 "Scrubbed $dberr loadavg records for system $system";
897 my ($err, $msg) = $self->AddRunlog(%runlog);
899 $self->Error("Unable to add runload (Error: $err)\n$msg") if $err;
902 return ($dberr, $dbmsg);
905 sub TrimStorage($$$) {
906 my ($self, $type, $tag, $region) = @_;
908 my $today = Today2SQLDatetime;
910 my $oldage = SubtractDays $today, $Clearadm::CLEAROPTS{CLEARADM_SCRUBDAYS};
912 my $table = $type =~ /vob/i
916 my ($dberr, $dbmsg) = $self->_deleteRecord(
918 "tag='$tag' and region='$region' and timestamp<='$oldage'"
921 if ($dbmsg eq 'Records deleted') {
922 return (0, $dbmsg) if $dberr == 0;
926 $runlog{task} = 'Scrub';
927 $runlog{started} = $today;
930 "Scrubbed $dberr ${type}storage records";
932 my ($err, $msg) = $self->AddRunlog(%runlog);
934 $self->Error("Unable to add runload (Error: $err)\n$msg") if $err;
937 return ($dberr, $dbmsg);
940 sub ValidateCCObjects() {
943 my $vobRecordsDeleted = 0;
944 my $viewRecordsDeleted = 0;
946 for my $region ($Clearcase::CC->regions) {
947 for my $type (qw(vob view)) {
949 verbose "Processing ${type}s in $region";
951 if ($type eq 'vob') {
952 verbose "Finding all vobs in region $region";
953 @ccobjs = $self->FindVob(undef, $region);
954 verbose 'Found ' . scalar @ccobjs . ' vobs to process';
955 } elsif ($type eq 'view') {
956 verbose "Finding all views in region $region";
957 @ccobjs = $self->FindView(undef, $region);
958 verbose 'Found ' . scalar @ccobjs . ' views to process';
961 for my $object (@ccobjs) {
962 my %ccobjrec = %$object;
964 verbose "Processing $ccobjrec{tag}:$ccobjrec{region}";
968 if ($type eq 'vob') {
969 $ccobj = Clearcase::Vob->new($ccobjrec{tag}, $ccobjrec{region});
971 $ccobj = Clearcase::View->new($ccobjrec{tag}, $ccobjrec{region});
974 verbose_nolf 'Checking if ' . $ccobj->{tag} . ':' . $ccobj->{region} . ' exists anymore...';
976 if ($ccobj->exists) {
977 verbose ' it does! Skipping...';
980 verbose ' it doesn\'t!';
983 #next if $ccobj->exists;
985 verbose "Deleting $type $ccobjrec{tag}:$ccobjrec{region}";
987 my ($recordsDeleted, $msg) = $self->_deleteRecord($type,
988 "tag='$ccobjrec{tag}' and region='$ccobjrec{region}'");
990 if ($msg ne 'Records deleted') {
991 return ($recordsDeleted, $msg);
993 $viewRecordsDeleted += $recordsDeleted if $type eq 'view';
994 $vobRecordsDeleted += $recordsDeleted if $type eq 'vob';
1000 return ($viewRecordsDeleted, $vobRecordsDeleted);
1001 } # ValidateCCObjects
1003 sub GetFS($$;$$$$) {
1004 my ($self, $system, $filesystem, $start, $end, $count, $interval) = @_;
1006 $system = $self->_aliasSystem($system);
1008 return unless $system;
1009 return unless $filesystem;
1011 $interval ||= 'Minute';
1013 my $size = $interval =~ /month/i
1015 : $interval =~ /day/i
1017 : $interval =~ /hour/i
1021 undef $start if $start and $start =~ /earliest/i;
1022 undef $end if $end and $end =~ /latest/i;
1024 my $condition = "system='$system' and filesystem='$filesystem'";
1025 $condition .= " and timestamp>='$start'" if $start;
1026 $condition .= " and timestamp<='$end'" if $end;
1028 $condition .= " group by left(timestamp,$size)";
1031 # We can't simply do a "limit 0, $count" as that just gets the front end of
1032 # the records return (i.e. if $count = say 10 and the timestamp range
1033 # returns 40 rows we'll see only rows 1-10, not rows 31-40). We need limit
1034 # $offset, $count where $offset = the number of qualifying records minus
1036 my $nbrRecs = $self->Count('fs', $condition);
1037 my $offset = $nbrRecs - $count;
1039 # Offsets of < 0 are not allowed.
1043 $condition .= " limit $offset, $count";
1046 my $statement = <<"END";
1051 left(timestamp,$size) as timestamp,
1063 my $sth = $self->{db}->prepare($statement);
1066 ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
1071 my $status = $sth->execute;
1074 ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
1081 while (my $row = $sth->fetchrow_hashref) {
1082 push @records, $row;
1088 sub GetLatestFS($$) {
1089 my ($self, $system, $filesystem) = @_;
1091 $system = $self->_aliasSystem($system);
1093 return unless $system;
1094 return unless $filesystem;
1096 my @records = $self->_getRecords(
1098 "system='$system' and filesystem='$filesystem'"
1099 . " order by timestamp desc limit 0, 1",
1103 return %{$records[0]};
1110 my ($self, %loadavg) = @_;
1112 my @requiredFields = (
1116 my $result = _checkRequiredFields \@requiredFields, \%loadavg;
1118 return -1, "AddLoadavg: $result" if $result;
1121 $loadavg{timestamp} = Today2SQLDatetime;
1123 return $self->_addRecord('loadavg', %loadavg);
1126 sub GetLoadavg($;$$$$) {
1127 my ($self, $system, $start, $end, $count, $interval) = @_;
1129 $system = $self->_aliasSystem($system);
1131 return unless $system;
1133 $interval ||= 'Minute';
1135 my $size = $interval =~ /month/i
1137 : $interval =~ /day/i
1139 : $interval =~ /hour/i
1145 undef $start if $start and $start =~ /earliest/i;
1146 undef $end if $end and $end =~ /latest/i;
1148 $condition .= " system='$system'" if $system;
1149 $condition .= " and timestamp>='$start'" if $start;
1150 $condition .= " and timestamp<='$end'" if $end;
1152 $condition .= " group by left(timestamp,$size)";
1155 # We can't simply do a "limit 0, $count" as that just gets the front end of
1156 # the records return (i.e. if $count = say 10 and the timestamp range
1157 # returns 40 rows we'll see only rows 1-10, not rows 31-40). We need limit
1158 # $offset, $count where $offset = the number of qualifying records minus
1160 my $nbrRecs = $self->Count('loadavg', $condition);
1161 my $offset = $nbrRecs - $count;
1163 # Offsets of < 0 are not allowed.
1164 $offset = 0 if $offset < 0;
1166 $condition .= " limit $offset, $count";
1169 my $statement = <<"END";
1172 left(timestamp,$size) as timestamp,
1175 avg(loadavg) as loadavg
1183 my $sth = $self->{db}->prepare($statement);
1186 ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
1191 my $status = $sth->execute;
1194 ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
1201 while (my $row = $sth->fetchrow_hashref) {
1202 push @records, $row;
1208 sub GetLatestLoadavg($) {
1209 my ($self, $system) = @_;
1211 $system = $self->_aliasSystem($system);
1213 return unless $system;
1215 my @records = $self->_getRecords(
1218 . " order by timestamp desc limit 0, 1",
1222 return %{$records[0]};
1226 } # GetLatestLoadavg
1228 sub GetStoragePool($$$;$$$$$) {
1229 my ($self, $type, $tag, $storage, $region, $start, $end, $count, $interval) = @_;
1231 $interval ||= 'Day';
1232 $region ||= $Clearcase::CC->region;
1234 return unless $type =~ /vob/i or $type =~ /view/;
1236 my $size = $interval =~ /month/i
1238 : $interval =~ /day/i
1240 : $interval =~ /hour/i
1244 undef $start if $start and $start =~ /earliest/i;
1245 undef $end if $end and $end =~ /latest/i;
1247 # Windows vob tags begin with "\", which is problematic. The solution is to
1249 $tag =~ s/^\\/\\\\/;
1252 my $table = $type eq 'vob' ? 'vobstorage' : 'viewstorage';
1254 $condition = "tag='$tag' and region='$region'";
1255 $condition .= " and timestamp>='$start'" if $start;
1256 $condition .= " and timestamp<='$end'" if $end;
1258 $condition .= " group by left(timestamp,$size)";
1261 # We can't simply do a "limit 0, $count" as that just gets the front end of
1262 # the records return (i.e. if $count = say 10 and the timestamp range
1263 # returns 40 rows we'll see only rows 1-10, not rows 31-40). We need limit
1264 # $offset, $count where $offset = the number of qualifying records minus
1266 my $nbrRecs = $self->Count($table, $condition);
1267 my $offset = $nbrRecs - $count;
1269 # Offsets of < 0 are not allowed.
1270 $offset = 0 if $offset < 0;
1272 $condition .= " limit $offset, $count";
1275 my $statement = <<"END";
1279 left(timestamp,$size) as timestamp,
1280 avg($storage) as size
1288 my $sth = $self->{db}->prepare($statement);
1291 ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
1296 my $status = $sth->execute;
1299 ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
1306 while (my $row = $sth->fetchrow_hashref) {
1307 push @records, $row;
1314 my ($self, %task) = @_;
1316 my @requiredFields = (
1321 my $result = _checkRequiredFields \@requiredFields, \%task;
1323 return -1, "AddTask: $result" if $result;
1325 return $self->_addRecord('task', %task);
1329 my ($self, $name) = @_;
1331 return $self->_deleteRecord('task', "name='$name'");
1335 my ($self, $name) = @_;
1339 my $condition = "name like '%$name%'";
1341 return $self->_getRecords('task', $condition);
1345 my ($self, $name) = @_;
1347 return unless $name;
1349 my @records = $self->_getRecords('task', "name='$name'");
1352 return %{$records[0]};
1358 sub UpdateTask($%) {
1359 my ($self, $name, %update) = @_;
1361 return $self->_updateRecord('task', "name='$name'", %update);
1364 sub AddSchedule(%) {
1365 my ($self, %schedule) = @_;
1367 my @requiredFields = (
1371 my $result = _checkRequiredFields \@requiredFields, \%schedule;
1373 return -1, "AddSchedule: $result" if $result;
1375 return $self->_addRecord('schedule', %schedule);
1378 sub DeleteSchedule($) {
1379 my ($self, $name) = @_;
1381 return $self->_deleteRecord('schedule', "name='$name'");
1384 sub FindSchedule(;$$) {
1385 my ($self, $name, $task) = @_;
1390 my $condition = "name like '%$name%'";
1391 $condition .= ' and ';
1392 $condition .= "task like '%$task%'";
1394 return $self->_getRecords('schedule', $condition);
1397 sub GetSchedule($) {
1398 my ($self, $name) = @_;
1400 my @records = $self->_getRecords('schedule', "name='$name'");
1403 return %{$records[0]};
1409 sub UpdateSchedule($%) {
1410 my ($self, $name, %update) = @_;
1412 return $self->_updateRecord('schedule', "name='$name'", %update);
1416 my ($self, %runlog) = @_;
1418 my @requiredFields = (
1422 my $result = _checkRequiredFields \@requiredFields, \%runlog;
1424 return -1, "AddRunlog: $result" if $result;
1426 $runlog{ended} = Today2SQLDatetime;
1428 $runlog{system} = hostname if $runlog{system} =~ /localhost/i;
1430 my ($err, $msg) = $self->_addRecord('runlog', %runlog);
1432 return ($err, $msg, $self->_getLastID);
1435 sub DeleteRunlog($) {
1436 my ($self, $condition) = @_;
1438 return $self->_deleteRecord('runlog', $condition);
1441 sub FindRunlog(;$$$$$$) {
1442 my ($self, $task, $system, $status, $id, $start, $page) = @_;
1444 # If ID is specified then that's all that really matters as it uniquely
1445 # identifies a runlog entry;
1446 my ($condition, $conditions);
1450 if ($task !~ /all/i) {
1452 $condition = "task like '%$task%'";
1455 if ($system !~ /all/i) {
1456 $condition .= ' and ' if $conditions;
1457 $condition .= "system like '%$system%'";
1462 $condition .= ' and ' if $conditions;
1464 if ($status =~ /!(-*\d+)/) {
1465 $condition .= "status<>$1";
1467 $condition .= "status=$status"
1471 # Need defined here as $start may be 0!
1472 if (defined $start) {
1474 $limit = "limit $start, $page";
1477 $condition = "id=$id";
1480 return $self->_getRecords('runlog', $condition, " order by started desc $limit");
1484 my ($self, $id) = @_;
1488 my @records = $self->_getRecords('runlog', "id=$id");
1491 return %{$records[0]};
1497 sub UpdateRunlog($%) {
1498 my ($self, $id, %update) = @_;
1500 return $self->_updateRecord('runlog', "id=$id", %update);
1504 my ($self, $table, $condition) = @_;
1506 $condition = $condition ? 'where ' . $condition : '';
1510 my $statement = "select count(*) from $table $condition";
1512 my $sth = $self->{db}->prepare($statement);
1515 ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
1520 my $status = $sth->execute;
1523 ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
1528 # Hack! Statements such as the following:
1530 # select count(*) from fs where system='jupiter' and filesystem='/dev/sdb5'
1531 # > group by left(timestamp,10);
1543 # 7 rows in set (0.00 sec)
1545 # Here we want 7 but what we see in $records[0] is 49. So the hack is that if
1546 # statement contains "group by" then we assume we have the above and return
1547 # scalar @records, otherwise we return $records[0];
1548 if ($statement =~ /group by/i) {
1549 my $allrows = $sth->fetchall_arrayref;
1551 return scalar @{$allrows};
1553 my @records = $sth->fetchrow_array;
1559 # GetWork returns two items, the number of seconds to wait before the next task
1560 # and array of hash records of work to be done immediately. The caller should
1561 # execute the work to be done, timing it, and subtracting it from the $sleep
1562 # time returned. If the caller exhausts the $sleep time then they should call
1569 my $statement = <<"END";
1571 schedule.name as schedulename,
1573 task.system as system,
1575 schedule.notification,
1577 runlog.started as lastrun
1580 schedule left join runlog on schedule.lastrunid=runlog.id
1582 schedule.task=task.name
1583 and schedule.active='true'
1587 my $sth = $self->{db}->prepare($statement);
1590 ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
1595 my $status = $sth->execute;
1598 ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
1606 while (my $row = $sth->fetchrow_hashref) {
1607 if ($$row{system} !~ /localhost/i) {
1608 my %system = $self->GetSystem($$row{system});
1610 # Skip inactive systems
1611 next if $system{active} eq 'false';
1614 # If started is not defined then this task was never run so run it now.
1615 unless ($$row{lastrun}) {
1616 push @records, $row;
1620 # TODO: Handle frequencies better.
1623 if ($$row{frequency} =~ /(\d+) seconds/i) {
1625 } elsif ($$row{frequency} =~ /(\d+) minute/i) {
1627 } elsif ($$row{frequency} =~ /(\d+) hour/i) {
1628 $seconds = $1 * 60 * 60;
1629 } elsif ($$row{frequency} =~ /(\d+) day/i) {
1630 $seconds= $1 * 60 * 60 * 24;
1632 warning "Don't know how to handle frequencies like $$row{frequency}";
1636 my $today = Today2SQLDatetime;
1637 my $lastrun = Add($$row{lastrun}, (seconds => $seconds));
1638 my $waitTime = DateToEpoch($lastrun) - DateToEpoch($today);
1640 if ($waitTime < 0) {
1641 # We're late - push this onto records and move on
1642 push @records, $row;
1645 $sleep ||= $waitTime;
1647 if ($sleep > $waitTime) {
1652 # Even if there is nothing to do the caller should sleep a bit and come back
1653 # to us. So if it ends up there's nothing past due, and nothing upcoming, then
1654 # sleep for a minute and return here. Somebody may have added a new task next
1655 # time we're called.
1656 if (@records == 0 and not $sleep) {
1660 return ($sleep, @records);
1663 sub GetUniqueList($$) {
1664 my ($self, $table, $field) = @_;
1668 my $statement = "select $field from $table group by $field";
1670 my $sth = $self->{db}->prepare($statement);
1673 ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
1678 my $status = $sth->execute;
1681 ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
1688 while (my @row = $sth->fetchrow_array) {
1690 push @values, $row[0];
1692 push @values, '<NULL>';
1700 my ($self, %alert) = @_;
1702 my @requiredFields = (
1707 my $result = _checkRequiredFields \@requiredFields, \%alert;
1709 return -1, "AddAlert: $result" if $result;
1711 return $self->_addRecord('alert', %alert);
1714 sub DeleteAlert($) {
1715 my ($self, $name) = @_;
1717 return $self->_deleteRecord('alert', "name='$name'");
1721 my ($self, $alert) = @_;
1725 my $condition = "name like '%$alert%'";
1727 return $self->_getRecords('alert', $condition);
1731 my ($self, $name) = @_;
1736 my @records = $self->_getRecords('alert', "name='$name'");
1739 return %{$records[0]};
1745 sub SendAlert($$$$$$$) {
1757 my $footing = '<hr><p style="text-align: center;">';
1758 $footing .= '<font color="#bbbbbb">';
1759 my $year = (localtime)[5] + 1900;
1760 $footing .= "<a href='$CLEAROPTS{CLEARADM_WEBBASE}'>Clearadm</a><br>";
1761 $footing .= "Copyright © $year, ClearSCM, Inc. - All rights reserved";
1763 my %alert = $self->GetAlert($alert);
1765 if ($alert{type} eq 'email') {
1766 my $from = 'Clearadm@' . hostdomain;
1771 subject => "Clearadm Alert: $system: $subject",
1774 footing => $footing,
1777 $self->Error("Don't know how to send $alert{type} alerts\n"
1778 . "Subject: $subject\n"
1779 . "Message: $message", 1);
1786 notification => $notification,
1787 runlog => $runlogID,
1788 timestamp => Today2SQLDatetime,
1789 message => $subject,
1792 return $self->AddAlertlog(%alertlog);
1795 sub GetLastAlert($$) {
1796 my ($self, $notification, $system) = @_;
1798 my $statement = <<"END";
1805 notification='$notification'
1806 and system='$system'
1813 my $sth = $self->{db}->prepare($statement)
1814 or return $self->_dberror('Unable to prepare statement', $statement);
1817 or return $self->_dberror('Unable to execute statement', $statement);
1819 my $alertlog= $sth->fetchrow_hashref;
1830 sub GetLastTaskFailure($$) {
1831 my ($self, $task, $system) = @_;
1833 my $statement = <<"END";
1842 and system='$system'
1850 my $sth = $self->{db}->prepare($statement)
1851 or return $self->_dberror('Unable to prepare statement', $statement);
1854 or return $self->_dberror('Unable to execute statement', $statement);
1856 my $runlog= $sth->fetchrow_hashref;
1860 if ($$runlog{ended}) {
1864 # If we didn't get any ended in the last call then there's nothing that
1865 # qualified. Still let's return a record (%runlog) that has a valid id so
1866 # that the caller can update that runlog with alerted = 'true'.
1867 $statement = <<"END";
1875 and system='$system'
1882 $sth = $self->{db}->prepare($statement)
1883 or return $self->_dberror('Unable to prepare statement', $statement);
1886 or return $self->_dberror('Unable to execute statement', $statement);
1888 $runlog = $sth->fetchrow_hashref;
1897 } # GetLastTaskFailure
1899 sub Notify($$$$$$) {
1911 $runlogID = $self->_getLastID
1916 # Update filesystem, if $filesystem was specified
1918 ($err, $msg) = $self->UpdateFilesystem(
1921 notification => $notification,
1925 $self->Error("Unable to set notification for filesystem $system:$filesystem "
1926 . "(Status: $err)\n$msg", $err) if $err;
1930 ($err, $msg) = $self->UpdateSystem(
1932 notification => $notification,
1936 my %notification = $self->GetNotification($notification);
1938 my %lastnotified = $self->GetLastAlert($notification, $system);
1940 if (%lastnotified and $lastnotified{timestamp}) {
1941 my $today = Today2SQLDatetime;
1942 my $lastnotified = $lastnotified{timestamp};
1944 if ($notification{nomorethan} =~ /hour/i) {
1945 $lastnotified = Add($lastnotified, (hours => 1));
1946 } elsif ($notification{nomorethan} =~ /day/i) {
1947 $lastnotified = Add($lastnotified, (days => 1));
1948 } elsif ($notification{nomorethan} =~ /week/i) {
1949 $lastnotified = Add($lastnotified, (days => 7));
1950 } elsif ($notification{nomorethan} =~ /month/i) {
1951 $lastnotified = Add($lastnotified, (month => 1));
1954 # If you want to fake an alert in the debugger just change $diff accordingly
1955 my $diff = Compare($today, $lastnotified);
1957 return if $diff <= 0;
1960 my $when = Today2SQLDatetime;
1961 my $nomorethan = lc $notification{nomorethan};
1962 my %alert = $self->GetAlert($notification{alert});
1963 my $to = $alert{who};
1965 # If $to is null then this means to send the alert to the admin for the
1969 my %system = $self->GetSystem($system);
1971 $to = $system{email};
1973 # If we don't know what system this error occurred on we'll have to notify
1974 # the "super user" defined as $self->{NOTIFY} (The receiver of last
1976 $to = $self->{NOTIFY};
1981 Error "To undefined";
1984 $message .= "<p>You will receive this alert no more than $nomorethan.</p>";
1986 ($err, $msg) = $self->SendAlert(
1987 $notification{alert},
1989 $notification{name},
1996 $self->Error("Unable to send alert (Status: $err)\n$msg", $err) if $err;
1998 verbose "Sent alert to $to";
2000 # Update runlog to indicate we notified the user for this execution
2001 ($err, $msg) = $self->UpdateRunlog(
2007 $self->Error("Unable to update runlog (Status: $err)\n$msg", $err) if $err;
2012 sub ClearNotifications($$;$) {
2013 my ($self, $system, $filesystem) = @_;
2018 ($err, $msg) = $self->UpdateFilesystem(
2020 $filesystem, (notification => undef),
2023 error "Unable to clear notification for filesystem $system:$filesystem "
2024 . "(Status: $err)\n$msg", $err
2027 # Check to see any of this system's filesystems have notifications. If none
2028 # then it's save to say we've turned off the last notification for a
2029 # filesystem involved with this system and if $system{notification} was
2030 # 'Filesystem' then we can toggle off the notification on the system too
2031 my $filesystemsAlerted = 0;
2033 for ($self->FindFilesystem($system)) {
2034 $filesystemsAlerted++
2035 if $$_{notification};
2038 my %system = $self->GetSystem($system);
2040 return unless $system;
2042 if ($system{notification} and
2043 $system{notification} eq 'Filesystem' and
2044 $filesystemsAlerted == 0) {
2045 ($err, $msg) = $self->UpdateSystem($system, (notification => undef));
2047 $self->Error("Unable to clear notification for system $system "
2048 . "(Status: $err)\n$msg", $err) if $err;
2051 ($err, $msg) = $self->UpdateSystem($system, (notification => undef));
2053 $self->Error("Unable to clear notification for system $system "
2054 . "(Status: $err)\n$msg", $err) if $err;
2058 } # ClearNotifications
2060 sub SystemAlive(%) {
2061 my ($self, %system) = @_;
2063 # If we've never heard from this system then we will assume that the system
2064 # has not been set up to run clearagent and has never checked in. In any event
2065 # we cannot say the system died because we've never known it to be alive!
2066 return 1 unless $system{lastheardfrom};
2068 # If a system is not active (may have been temporarily been deactivated) then
2069 # we don't want to turn on the bells and whistles alerting people it's down.
2070 return 1 if $system{active} eq 'false';
2072 my $today = Today2SQLDatetime;
2073 my $lastheardfrom = $system{lastheardfrom};
2075 my $tenMinutes = 10 * 60;
2077 $lastheardfrom = Add($lastheardfrom, (seconds => $tenMinutes));
2079 if (DateToEpoch($lastheardfrom) < DateToEpoch($today)) {
2080 $self->UpdateSystem(
2082 notification => 'Heartbeat'
2088 if ($system{notification}) {
2089 $self->UpdateSystem(
2091 notification => undef
2099 sub UpdateAlert($%) {
2100 my ($self, $name, %update) = @_;
2102 return $self->_updateRecord(
2109 sub AddAlertlog(%) {
2110 my ($self, %alertlog) = @_;
2112 my @requiredFields = (
2117 my $result = _checkRequiredFields \@requiredFields, \%alertlog;
2119 return -1, "AddAlertlog: $result" if $result;
2122 $alertlog{timestamp} = Today2SQLDatetime;
2124 return $self->_addRecord('alertlog', %alertlog);
2127 sub DeleteAlertlog($) {
2128 my ($self, $condition) = @_;
2133 if ($condition =~ /all/i) {
2134 return $self->_deleteRecord('alertlog');
2136 return $self->_deleteRecord('alertlog', $condition);
2140 sub FindAlertlog(;$$$$$) {
2141 my ($self, $alert, $system, $notification, $start, $page) = @_;
2145 $notification ||= '';
2147 my $condition = "alert like '%$alert%'";
2148 $condition .= ' and ';
2149 $condition .= "system like '%$system%'";
2150 $condition .= ' and ';
2151 $condition .= "notification like '%$notification%'";
2152 $condition .= " order by timestamp desc";
2154 if (defined $start) {
2156 $condition .= " limit $start, $page";
2159 return $self->_getRecords('alertlog', $condition);
2162 sub GetAlertlog($) {
2163 my ($self, $alert) = @_;
2165 return unless $alert;
2167 my @records = $self->_getRecords('alertlog', "alert='$alert'");
2170 return %{$records[0]};
2176 sub UpdateAlertlog($%) {
2177 my ($self, $alert, %update) = @_;
2179 return $self->_updateRecord(
2186 sub AddNotification(%) {
2187 my ($self, %notification) = @_;
2189 my @requiredFields = (
2195 my $result = _checkRequiredFields \@requiredFields, \%notification;
2197 return -1, "AddNotification: $result" if $result;
2199 return $self->_addRecord('notification', %notification);
2202 sub DeleteNotification($) {
2203 my ($self, $name) = @_;
2205 return $self->_deleteRecord('notification', "name='$name'");
2208 sub FindNotification(;$$) {
2209 my ($self, $name, $cond, $ordering) = @_;
2213 my $condition = "name like '%$name%'";
2214 $condition .= " and $cond"
2217 return $self->_getRecords('notification', $condition);
2218 } # FindNotification
2220 sub GetNotification($) {
2221 my ($self, $name) = @_;
2223 return unless $name;
2225 my @records = $self->_getRecords('notification', "name='$name'");
2228 return %{$records[0]};
2234 sub UpdateNotification($%) {
2235 my ($self, $name, %update) = @_;
2237 return $self->_updateRecord(
2242 } # UpdateNotification
2244 sub AddVobStorage(%) {
2245 my ($self, %vobstorage) = @_;
2247 my @requiredFields = (
2251 my $result = _checkRequiredFields \@requiredFields, \%vobstorage;
2253 return -1, "AddVobStorage: $result" if $result;
2256 $vobstorage{timestamp} = Today2SQLDatetime;
2258 return $self->_addRecord('vobstorage', %vobstorage);
2261 sub AddViewStorage(%) {
2262 my ($self, %viewstorage) = @_;
2264 my @requiredFields = (
2268 my $result = _checkRequiredFields \@requiredFields, \%viewstorage;
2270 return -1, "AddViewStorage: $result" if $result;
2273 $viewstorage{timestamp} = Today2SQLDatetime;
2275 return $self->_addRecord('viewstorage', %viewstorage);
2282 =head1 CONFIGURATION AND ENVIRONMENT
2284 DEBUG: If set then $debug is set to this level.
2286 VERBOSE: If set then $verbose is set to this level.
2288 TRACE: If set then $trace is set to this level.
2300 L<Net::Domain|Net::Domain>
2302 =head2 ClearSCM Perl Modules
2316 <a href="http://clearscm.com/php/scm_man.php?file=lib/DateUtils.pm">DateUtils</a><br>
2317 <a href="http://clearscm.com/php/scm_man.php?file=lib/Display.pm">Display</a><br>
2318 <a href="http://clearscm.com/php/scm_man.php?file=lib/GetConfig.pm">GetConfig</a><br>
2319 <a href="http://clearscm.com/php/scm_man.php?file=lib/Mail.pm">Mail</a><br>
2324 =head1 BUGS AND LIMITATIONS
2326 There are no known bugs in this module
2328 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
2330 =head1 LICENSE AND COPYRIGHT
2332 Copyright (c) 2010, ClearSCM, Inc. All rights reserved.