-#!/usr/bin/env perl
+#!/usr/local/bin/perl
=pod
use FindBin;
use Getopt::Long;
+use Sys::Hostname;
use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib";
my ($host, $fs);
+my %opts = (
+ scrubdays => $Clearadm::CLEAROPTS{CLEARADM_SCRUBDAYS}
+);
+
# Main
-GetOptions (
- 'usage' => sub { Usage },
- 'verbose' => sub { set_verbose },
- 'debug' => sub { set_debug },
+GetOptions(
+ \%opts,
+ 'usage' => sub { Usage },
+ 'verbose' => sub { set_verbose },
+ 'debug' => sub { set_debug },
+ "scrubdays=i",
) or Usage "Invalid parameter";
-Usage 'Extraneous options: ' . join ' ', @ARGV
- if @ARGV;
+Usage 'Extraneous options: ' . join ' ', @ARGV if @ARGV;
# Announce ourselves
verbose "$FindBin::Script V$VERSION";
my ($err, $msg);
-foreach my $system ($clearadm->FindSystem ($host)) {
- ($err, $msg) = $clearadm->TrimLoadavg ($$system{name});
+for my $system ($clearadm->FindSystem($host)) {
+ ($err, $msg) = $clearadm->TrimLoadavg($system->{name});
if ($msg eq 'Records deleted' or $msg eq '') {
- verbose "Scrub loadavg $$system{name}: $err $msg:";
+ verbose "Scrub loadavg $system->{name}: $err $msg:";
} else {
error "#$err: $msg";
} # if
- foreach my $filesystem ($clearadm->FindFilesystem ($$system{name}, $fs)) {
- ($err, $msg) = $clearadm->TrimFS ($$system{name}, $$filesystem{filesystem});
+ for my $filesystem ($clearadm->FindFilesystem($system->{name}, $fs)) {
+ ($err, $msg) = $clearadm->TrimFS($system->{name}, $filesystem->{filesystem});
if ($msg eq 'Records deleted' or $msg eq '') {
- verbose "Scrub filesystem $$system{name}:$$filesystem{filesystem}: $err $msg";
+ verbose "Scrub filesystem $system->{name}:$filesystem->{filesystem}: $err $msg";
} else {
error "#$err: $msg";
} # if
- } # foreach
-} # foreach
+ } # for
+} # for
-# TODO: These should be configurable
-my $sixMonthsAgo = SubtractDays (Today2SQLDatetime, 180);
+my $scrubdate = SubtractDays(Today2SQLDatetime, $opts{scrubdays});
my %runlog = (
task => 'Scrub',
started => Today2SQLDatetime,
+ system => hostname(),
);
+# Scrub view and vob storage records
+for ($clearadm->FindVob) {
+ ($err, $msg) = $clearadm->TrimStorage('vob', $_->{tag}, $_->{region});
+
+ if ($msg eq 'Records deleted' or $msg eq '') {
+ verbose "Scub VOB $_->{tag} $err $msg";
+ } else {
+ error "#$err: $msg";
+ } # if
+} # for
+
+for ($clearadm->FindView) {
+ ($err, $msg) = $clearadm->TrimStorage('view', $_->{tag}, $_->{region});
+
+ if ($msg eq 'Records deleted' or $msg eq '') {
+ verbose "Scub View $_->{tag} $err $msg";
+ } else {
+ error "#$err: $msg";
+ } # if
+} # for
+
+# Make sure the Clearcase objects we have in Clearadm are still valid
+my ($views, $vobs) = $clearadm->ValidateCCObjects;
+
+if ($vobs !~ /^\d+/) {
+ error "Unable to validate Clearcase objects: $vobs", $views;
+} else {
+ $runlog{status} = 0;
+
+ $runlog{message} = "Deleted $views views\n" if $views;
+ $runlog{message} .= "Deleted $vobs vobs" if $vobs;
+
+ $clearadm->AddRunlog(%runlog);
+} # if
+
# Scrub old alertlogs
($runlog{status}, $runlog{message}) =
- $clearadm->DeleteAlertlog ("timestamp<='$sixMonthsAgo'");
+ $clearadm->DeleteAlertlog ("timestamp<='$scrubdate'");
verbose "$runlog{task} alertlog: $runlog{status} $runlog{message}";
# Scrub old runlogs
($runlog{status}, $runlog{message}) =
- $clearadm->DeleteRunlog ("started<='$sixMonthsAgo'");
+ $clearadm->DeleteRunlog ("started<='$scrubdate'");
verbose "$runlog{task} runlog: $runlog{status} $runlog{message}";
-$clearadm->AddRunlog (%runlog);
+$clearadm->AddRunlog(%runlog);
=pod
my $multithreaded = $Clearexec::CLEAROPTS{CLEAREXEC_MULTITHREADED};
my $daemon = 1;
-GetOptions (
+GetOptions(
'usage' => sub { Usage },
'verbose' => sub { set_verbose },
'debug' => sub { set_debug },
$clearexec = Clearexec->new;
-$clearexec->setMultithreaded ($multithreaded);
+$clearexec->setMultithreaded($multithreaded);
my $logfile = "$Clearexec::CLEAROPTS{CLEAREXEC_LOGDIR}/$FindBin::Script";
$logfile =~ s/\.pl$//;
$logfile .= '.' . hostname() . '.log';
-EnterDaemonMode $logfile, $logfile, $pidfile
- if $daemon;
+EnterDaemonMode $logfile, $logfile, $pidfile if $daemon;
display "$FindBin::Script V$VERSION started at " . localtime;
use Getopt::Long;
use FindBin;
-use Term::ANSIColor qw (color);
+use Term::ANSIColor qw(color);
use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib";
my $clearexec;
-sub CmdLoop () {
+sub CmdLoop() {
my ($line, $result);
- my $prompt = color ('BOLD YELLOW') . "$me->$host:" . color ('RESET');
+ my $prompt = color('BOLD YELLOW') . "$me->$host:" . color('RESET');
- $CmdLine::cmdline->set_prompt ($prompt);
+ $CmdLine::cmdline->set_prompt($prompt);
- while (($line, $result) = $CmdLine::cmdline->get ()) {
+ while (($line, $result) = $CmdLine::cmdline->get()) {
last unless defined $line;
last if $line =~ /exit|quit/i;
- my ($status, @output) = $clearexec->execute ($line);
+ my ($status, @output) = $clearexec->execute($line);
last if $line =~ /stopserver/i;
} # CmdLoop
# Main
-GetOptions (
+GetOptions(
'usage' => sub { Usage },
'verbose' => sub { set_verbose },
'debug' => sub { set_debug },
verbose "$FindBin::Script V$VERSION";
-$clearexec =Clearexec->new;
+$clearexec = Clearexec->new;
my ($status, @output);
-$status = $clearexec->connectToServer ($host, $port);
+$status = $clearexec->connectToServer($host, $port);
-error "Unable to connect to $host:$port", 1
- unless $status;
+error "Unable to connect to $host:$port", 1 unless $status;
if ($cmd ne '') {
- ($status, @output) = $clearexec->execute ($cmd);
+ ($status, @output) = $clearexec->execute($cmd);
if ($status) {
- error "Unable to execute $cmd (Status: $status)\n" . join ("\n", @output), 1;
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), 1;
} else {
display join "\n", @output;
display "Status: $status";
$SIG{USR1} = \&ToggleVerbose;
-sub HandleSystemNotCheckingIn (%) {
+sub HandleSystemNotCheckingIn(%) {
my (%system) = @_;
my $startTime = time;
system => $system{name},
);
- my ($err, $msg, $lastid) = $clearadm->AddRunlog (%runlog);
+ my ($err, $msg, $lastid) = $clearadm->AddRunlog(%runlog);
$clearadm->Error ("Unable to add to runlog (Status: $err)\n$msg") if $err;
$systemLink .= "/systemdetails.cgi?system=$system{name}";
my $runlogLink = $Clearadm::CLEAROPTS{CLEARADM_WEBBASE};
$runlogLink .= "/runlog.cgi?id=$lastid";
- my $subject = "System is not responding (Is clearagent running?)";
- $message = <<"END";
+ my $subject = "System is not responding (Is clearagent running?)";
+ $message = <<"END";
<center>
<h1><font color="red">Alert</font> System not responding!</h1>
</center>
clearagent is not setup and running on the system.</p>
END
- $clearadm->Notify (
+ $clearadm->Notify(
$notification{name},
$subject,
$message,
return;
} # HandleSystemNotCheckingIn
-sub SystemsCheckin () {
+sub SystemsCheckin() {
for ($clearadm->FindSystem) {
my %system = %$_;
my $startTime = time;
- my $status = $clearexec->connectToServer (
- $system{name},
- $system{port}
- );
+ my $status = $clearexec->connectToServer($system{name}, $system{port});
unless ($status) {
HandleSystemNotCheckingIn %system;
. "$system{name}:$system{port}";
display __FILE__ . " DEBUG: System undefined 1" unless $system{name};
- $clearadm->UpdateSystem (
- $system{name},
- (lastheardfrom => Today2SQLDatetime)
- );
+ $clearadm->UpdateSystem($system{name}, (lastheardfrom => Today2SQLDatetime));
$clearadm->ClearNotifications ($system{name})
if $system{notification} and $system{notification} eq 'Heartbeat';
return;
} # SystemsCheckin
-sub UpdateRunlog ($$$$) {
+sub UpdateRunlog($$$$) {
my ($status, $startTime, $task, $output) = @_;
my %runlog = (
} # if
} # if
- my ($err, $msg, $lastid) = $clearadm->AddRunlog (%runlog);
+ my ($err, $msg, $lastid) = $clearadm->AddRunlog(%runlog);
- $clearadm->Error ($msg, $err) if $err;
+ $clearadm->Error($msg, $err) if $err;
return $lastid;
} # UpdateRunlog
-sub MakeSystemLink ($) {
+sub MakeSystemLink($) {
my ($system) = @_;
return "$Clearadm::CLEAROPTS{CLEARADM_WEBBASE}/systemdetails.cgi?system="
. $system;
} # MakeSystemLink
-sub MakeLoadavgLink ($) {
+sub MakeLoadavgLink($) {
my ($system) = @_;
return "$Clearadm::CLEAROPTS{CLEARADM_WEBBASE}/plot.cgi?type=loadavg&system="
. "$system&scaling=Hour&points=24";
} # MakeLoadavgLink
-sub ProcessLoadavgErrors ($$$$@) {
+sub ProcessLoadavgErrors($$$$@) {
# TODO: Also need to handle the case where the error was something other
# than "Load average over threshold". Perhaps by having different return
# status. Also, runlog entry #22169 never reported!
END
$message .= join "\n", @output;
$message .= "</pre>";
- $clearadm->Error ($message, -1);
+ $clearadm->Error($message, -1);
last;
} # if
- $clearadm->Notify (
+ $clearadm->Notify(
$notification,
$subject,
$message,
return;
} # ProcessLoadAvgErrors
-sub ProcessFilesystemErrors ($$$$@) {
+sub ProcessFilesystemErrors($$$$@) {
# TODO: Also need to handle the case where the error was something other
# than "Filesystem over threshold". Perhaps by having different return
# status.
push @fsinfo, @{$system{$systemName}};
} # if
- my $systemLink = MakeSystemLink ($systemName);
+ my $systemLink = MakeSystemLink($systemName);
my $subject = 'Filesystem has exceeded threshold';
my $message = <<"END";
<center>
$message .= "</ul>";
- $clearadm->Notify (
+ $clearadm->Notify(
$notification,
$subject,
$message,
return;
} # ProcessFilesystemErrors
-sub NonZeroReturn ($$$$$$) {
+sub NonZeroReturn($$$$$$) {
my ($system, $notification, $status, $lastid, $output, $task) = @_;
my @output = @{$output};
$message .= "</pre></blockquote>";
- $clearadm->Notify (
+ $clearadm->Notify(
$notification,
$subject,
$message,
return;
} # NonZeroReturn
-sub ExecuteTask ($%) {
+sub ExecuteTask($%) {
my ($sleep, %task) = @_;
my ($status, @output, %system, $subject, $message);
. "execute $task{command}";
$status = -1;
} else {
- ($status, @output) = $clearexec->execute ($task{command});
+ ($status, @output) = $clearexec->execute($task{command});
$output[0] = "Unable to exec $task{command} on $system{name}"
if $status == -1;
if ($status != 0) {
if ($notification{cond}
and $notification{cond} =~ /non zero return/i) {
- NonZeroReturn (
+ NonZeroReturn(
$system{name},
$notification{name},
$status,
\%task
);
} elsif ($notification{cond} =~ /loadavg over threshold/i) {
- ProcessLoadavgErrors ($notification{name}, $task{name}, $system{name}, $lastid, @output);
+ ProcessLoadavgErrors($notification{name}, $task{name}, $system{name}, $lastid, @output);
} elsif ($notification{cond} =~ /filesystem over threshold/i) {
- ProcessFilesystemErrors ($notification{name}, $task{name}, $system{name}, $lastid, @output);
+ ProcessFilesystemErrors($notification{name}, $task{name}, $system{name}, $lastid, @output);
} # if
} else {
- $clearadm->ClearNotifications ($task{system});
+ $clearadm->ClearNotifications($task{system});
} # if
- my ($err, $msg) = $clearadm->UpdateSchedule (
+ my ($err, $msg) = $clearadm->UpdateSchedule(
$task{schedulename},
( 'lastrunid' => $lastid ),
);
- $clearadm->Error ($msg, $err) if $err;
+ $clearadm->Error($msg, $err) if $err;
$sleep -= time - $startTime;
} # ExecuteTask
# Main
-GetOptions (
+GetOptions(
'usage' => sub { Usage },
'verbose' => sub { set_verbose },
'debug' => sub { set_debug },
'pidfile=s' => \$pidfile,
) or Usage "Invalid parameter";
-Usage 'Extraneous options: ' . join ' ', @ARGV
- if @ARGV;
+Usage 'Extraneous options: ' . join ' ', @ARGV if @ARGV;
-EnterDaemonMode $logfile, $logfile, $pidfile
- if $daemon;
+EnterDaemonMode $logfile, $logfile, $pidfile if $daemon;
display "$FindBin::Script V$VERSION started at " . localtime;
my $broadcastTime = 10;
-sub discover ($) {
+sub discover($) {
my ($broadcast) = @_;
my $startTime = time;
} # unless
} # if
- last
- if (time () - $startTime) > $broadcastTime;
+ last if (time() - $startTime) > $broadcastTime;
} # while
verbose "$broadcastTime seconds has elapsed - discovery complete";
} # discover
# Main
-my $broadcastAddress = inet_ntoa (INADDR_BROADCAST);
+my $broadcastAddress = inet_ntoa(INADDR_BROADCAST);
-GetOptions (
+GetOptions(
usage => sub { Usage },
verbose => sub { set_verbose },
debug => sub { set_debug },
'broadcastAddr=s' => \$broadcastAddress,
) or Usage "Invalid parameter";
-Usage 'Extraneous options: ' . join ' ', @ARGV
- if @ARGV;
+Usage 'Extraneous options: ' . join ' ', @ARGV if @ARGV;
# Announce ourselves
verbose "$FindBin::Script V$VERSION";
verbose_nolf 's' if $nbrHosts != 1;
verbose " on subnet $broadcastAddress";
-foreach (sort values %hosts) {
- my $verbose = get_verbose () ? '-verbose' : '';
+for (sort values %hosts) {
+ my $verbose = get_verbose() ? '-verbose' : '';
my ($status, @output) = Execute "updatesystem.pl -host $_ $verbose";
- error "Unable to update host $_ (Status: $status)\n"
- . join ("\n", @output), 1
- if $status;
+ error "Unable to update host $_ (Status: $status)\n" . join ("\n", @output), 1 if $status;
verbose join "\n", @output;
-} # foreach
+} # for
=pod
use FindBin;
use Getopt::Long;
-use CGI qw (:standard *table start_Tr end_Tr);
+use CGI qw(:standard *table start_Tr end_Tr);
use CGI::Carp 'fatalsToBrowser';
+use Convert::Base64;
use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib";
my $clearadm = Clearadm->new;
# Main
-GetOptions (
+GetOptions(
'usage' => sub { Usage },
'verbose' => sub { set_verbose },
'debug' => sub { set_debug },
$perRow = @systems if @systems < $perRow;
-foreach (@systems) {
+for (@systems) {
my %system = %{$_};
if ($i++ % $perRow == 0) {
my $data;
- $data = '<strike>'
- if $system{active} eq 'false';
+ $data = '<strike>' if $system{active} eq 'false';
$data .= a {
href => "systemdetails.cgi?system=$system{name}"
if ($system{notification}) {
$data .= ' ' . a {
- href => "alertlog.cgi?system=$system{name}"}, img {
+ href => "alertlog.cgi?system=$system{name}"}, img {
src => 'alert.png',
border => 0,
alt => 'Alert!',
};
} # if
+ my $image = $system{loadavgsmall}
+ ? "data:image/png;base64,$system{loadavgsmall}"
+ : "plotloadavg.cgi?system=$system{name}&tiny=1";
+
$data .= '<br>' .
a {href =>
"plot.cgi?type=loadavg&system=$system{name}&scaling=Hour&points=24"
}, img {
- src => "plotloadavg.cgi?system=$system{name}&tiny=1",
+ src => $image,
border => 0,
};
- $data .= '</strike>'
- if $system{active} eq 'false';
+ $data .= '</strike>' if $system{active} eq 'false';
$load{uptime} ||= 'Unknown';
display td {class => 'dataCentered'}, "$data ",
font {class => 'dim' }, "<br>Up: $load{uptime}";
-} # foreach
+} # for
while ($i % $perRow != 0) {
$i++;
my $clearadm = new Clearadm;
# Add a new system
- my %system = (
+ my %system =(
name => 'jupiter',
alias => 'defaria.com',
admin => 'Andrew DeFaria',
description => 'Home server',
);
- my ($err, $msg) = $clearadm->AddSystem (%system);
+ my ($err, $msg) = $clearadm->AddSystem(%system);
# Find systems matching 'jup'
- my @systems = $clearadm->FindSystem ('jup');
+ my @systems = $clearadm->FindSystem('jup');
# Get a system by name
- my %system = $clearadm->GetSystem ('jupiter');
+ my %system = $clearadm->GetSystem('jupiter');
# Update system
my %update = (
# Delete system (Warning: will delete all related records regarding this
# system).
- my ($err, $msg) = $clearadm->DeleteSystem ('jupiter');
+ my ($err, $msg) = $clearadm->DeleteSystem('jupiter');
=head1 DESCRIPTION
use Display;
use GetConfig;
use Mail;
+use Clearcase::Vob;
+use Clearcase::View;
my $conf = dirname(__FILE__) . '/../etc/clearadm.conf';
my @returnValues;
# Quote data values
- push @returnValues, $_ eq '' ? 'null' : $self->{db}->quote($_)
- for (@values);
+ push @returnValues, $_ eq '' ? 'null' : $self->{db}->quote($_) for (@values);
return @returnValues;
} # _formatValues
my @nameValueStrs;
- push @nameValueStrs, "$_=" . $self->{db}->quote($rec{$_})
- for (keys %rec);
+ push @nameValueStrs, "$_=" . $self->{db}->quote($rec{$_}) for (keys %rec);
return @nameValueStrs;
} # _formatNameValues
my $count;
my $statement = "select count(*) from $table ";
- $statement .= "where $condition"
- if $condition;
+ $statement .= "where $condition" if $condition;
my $sth = $self->{db}->prepare($statement)
or return $self->_dberror('Unable to prepare statement', $statement);
$count = 0;
} # if
- return ($count, 'Records deleted')
- if $count == 0;
+ return ($count, 'Records deleted') if $count == 0;
$statement = "delete from $table ";
- $statement .= "where $condition"
- if $condition;
+ $statement .= "where $condition" if $condition;
$self->{db}->do($statement);
my $statement = "update $table set ";
$statement .= join ',', $self->_formatNameValues(%rec);
- $statement .= " where $condition"
- if $condition;
+ $statement .= " where $condition" if $condition;
$self->{db}->do($statement);
} # if
} # for
- return "$fieldname is required"
- unless $found;
+ return "$fieldname is required" unless $found;
} # for
return;
if ($system{name}) {
return $system{name};
} else {
- return;
+ return;
} # if
} # _aliasSystem
my $result = _checkRequiredFields \@requiredFields, \%system;
- return -1, "AddSystem: $result"
- if $result;
+ return -1, "AddSystem: $result" if $result;
$system{loadavgHist} ||= $defaultLoadavgHist;
sub GetSystem($) {
my ($self, $system) = @_;
- return
- unless $system;
+ return unless $system;
my @records = $self->_getRecords(
'system',
if ($records[0]) {
return %{$records[0]};
} else {
- return;
+ return;
} # if
} # GetSystem
my $result = _checkRequiredFields \@requiredFields, \%package;
- return -1, "AddPackage: $result"
- if $result;
+ return -1, "AddPackage: $result" if $result;
return $self->_addRecord('package', %package);
} # AddPackage
$system = $self->_aliasSystem($system);
- return
- unless $system;
+ return unless $system;
return $self->_updateRecord('package', "system='$system'", %update);
} # UpdatePackage
$system = $self->_aliasSystem($system);
- return
- unless $system;
-
- return
- unless $name;
+ return unless $system;
+ return unless $name;
my @records = $self->_getRecords(
'package',
if ($records[0]) {
return %{$records[0]};
} else {
- return;
+ return;
} # if
} # GetPackage
$system = $self->_aliasSystem($system);
- return
- unless $system;
+ return unless $system;
my $condition = "system='$system' and name like '%$name%'";
my $result = _checkRequiredFields \@requiredFields, \%filesystem;
- return -1, "AddFilesystem: $result"
- if $result;
+ return -1, "AddFilesystem: $result" if $result;
# Default filesystem threshold
$filesystem{threshold} ||= $defaultFilesystemThreshold;
$system = $self->_aliasSystem($system);
- return
- unless $system;
+ return unless $system;
return $self->_deleteRecord(
'filesystem',
$system = $self->_aliasSystem($system);
- return
- unless $system;
+ return unless $system;
return $self->_updateRecord(
'filesystem',
$system = $self->_aliasSystem($system);
- return
- unless $system;
-
- return
- unless $filesystem;
+ return unless $system;
+ return unless $filesystem;
my @records = $self->_getRecords(
'filesystem',
$system = $self->_aliasSystem($system);
- return
- unless $system;
+ return unless $system;
my $condition = "system='$system' and filesystem like '%$filesystem%'";
my ($self, %vob) = @_;
my @requiredFields = (
- 'system',
'tag',
+ 'region',
);
my $result = _checkRequiredFields \@requiredFields, \%vob;
- return -1, "AddVob: $result"
- if $result;
+ return -1, "AddVob: $result" if $result;
return $self->_addRecord('vob', %vob);
} # AddVob
-sub DeleteVob($) {
- my ($self, $tag) = @_;
+sub DeleteVob($$) {
+ my ($self, $tag, $region) = @_;
- return $self->_deleteRecord('vob', "tag='$tag'");
+ return $self->_deleteRecord('vob', "tag='$tag' and region='$region'");
} # DeleteVob
-sub GetVob($) {
- my ($self, $tag) = @_;
+sub GetVob($$) {
+ my ($self, $tag, $region) = @_;
- return
- unless $tag;
+ return unless $tag;
- my @records = $self->_getRecords('vob', "tag='$tag'");
+ # Windows vob tags begin with "\", which is problematic. The solution is to
+ # escape the "\"
+ $tag =~ s/^\\/\\\\/;
+
+ my @records = $self->_getRecords('vob', "tag='$tag' and region='$region'");
if ($records[0]) {
return %{$records[0]};
} else {
- return;
+ return;
} # if
} # GetVob
-sub FindVob($) {
- my ($self, $tag) = @_;
+sub FindVobStorage(;$$) {
+ my ($self, $tag, $region) = @_;
+
+ $tag ||= '';
+ $region ||= '';
+
+ # Windows vob tags begin with "\", which is problematic. The solution is to
+ # escape the "\"
+ $tag =~ s/^\\/\\\\/;
- return $self->_getRecords('vob', "tag like '%$tag%'");
+ my $condition = "tag like '%$tag%'";
+
+ $condition .= " and region='$region'" if $region;
+
+ return $self->_getRecords('vobstorage', $condition);
+} # FindVobStorage
+
+sub FindVob(;$$) {
+ my ($self, $tag, $region) = @_;
+
+ $tag ||= '';
+ $region ||= '';
+
+ # Windows vob tags begin with "\", which is problematic. The solution is to
+ # escape the "\"
+ $tag =~ s/^\\/\\\\/;
+
+ my $condition = "tag like '%$tag%'";
+
+ $condition .= " and region='$region'" if $region;
+
+ return $self->_getRecords('vob', $condition);
} # FindVob
+sub UpdateVob(%) {
+ my ($self, %vob) = @_;
+
+ # Windows vob tags begin with "\", which is problematic. The solution is to
+ # escape the "\"
+ my $vobtag = $vob{tag};
+
+ $vobtag =~ s/^\\/\\\\/;
+
+ return $self->_updateRecord('vob', "tag='$vobtag' and region='$vob{region}'", %vob);
+} # UpdateVob
+
sub AddView(%) {
my ($self, %view) = @_;
my @requiredFields = (
- 'system',
'tag',
+ 'region'
);
my $result = _checkRequiredFields \@requiredFields, \%view;
- return -1, "AddView: $result"
- if $result;
+ return -1, "AddView: $result" if $result;
return $self->_addRecord('view', %view);
} # AddView
-sub DeleteView($) {
- my ($self, $tag) = @_;
+sub DeleteView($$) {
+ my ($self, $tag, $region) = @_;
- return $self->_deleteRecord('vob', "tag='$tag'");
+ return $self->_deleteRecord('vob', "tag='$tag' and region='$region'");
} # DeleteView
-sub UpdateView($$) {
- my ($self, $tag, $region, %viewRec) = @_;
+sub UpdateView(%) {
+ my ($self, %view) = @_;
- return $self->_updateRecord('view', "tag='$tag' and region='$region'", %viewRec);
+ return $self->_updateRecord('view', "tag='$view{tag}' and region='$view{region}'", %view);
} # UpdateView
sub GetView($$) {
} # GetView
sub FindView(;$$$$) {
- my ($self, $system, $region, $tag, $ownerName) = @_;
-
- $system ||= '';
- $region ||= '';
- $tag ||= '';
- $ownerName ||= '';
+ my ($self, $tag, $region, $ownerName) = @_;
my $condition;
+ my @conditions;
- $condition = "system like '%$system%'";
- $condition .= ' and ';
- $condition = "region like '%$region%'";
- $condition .= ' and ';
- $condition .= "tag like '%$tag'";
- $condition .= ' and ';
- $condition .= "ownerName like '%$ownerName'";
+ push @conditions, "tag like '%$tag%'" if $tag;
+ push @conditions, "region = '$region'" if $region;
+ push @conditions, "ownerName like '$ownerName'" if $ownerName;
+
+ $condition = join " and ", @conditions if @conditions;
return $self->_getRecords('view', $condition);
} # FindView
my %filesystem = $self->GetFilesystem($system, $filesystem);
- return
- unless %filesystem;
+ return unless %filesystem;
my %task = $self->GetTask('scrub');
);
if ($dbmsg eq 'Records deleted') {
- return (0, $dbmsg)
- if $dberr == 0;
+ return (0, $dbmsg) if $dberr == 0;
my %runlog;
my %system = $self->GetSystem($system);
- return
- unless %system;
+ return unless %system;
my %task = $self->GetTask('loadavg');
);
if ($dbmsg eq 'Records deleted') {
- return (0, $dbmsg)
- if $dberr == 0;
+ return (0, $dbmsg) if $dberr == 0;
my %runlog;
return ($dberr, $dbmsg);
} # TrimLoadavg
+sub TrimStorage($$$) {
+ my ($self, $type, $tag, $region) = @_;
+
+ my $today = Today2SQLDatetime;
+
+ my $oldage = SubtractDays $today, $Clearadm::CLEAROPTS{CLEARADM_SCRUBDAYS};
+
+ my $table = $type =~ /vob/i
+ ? 'vobstorage'
+ : 'viewstorage';
+
+ my ($dberr, $dbmsg) = $self->_deleteRecord(
+ $table,
+ "tag='$tag' and region='$region' and timestamp<='$oldage'"
+ );
+
+ if ($dbmsg eq 'Records deleted') {
+ return (0, $dbmsg) if $dberr == 0;
+
+ my %runlog;
+
+ $runlog{task} = 'Scrub';
+ $runlog{started} = $today;
+ $runlog{status} = 0;
+ $runlog{message} =
+ "Scrubbed $dberr ${type}storage records";
+
+ my ($err, $msg) = $self->AddRunlog(%runlog);
+
+ $self->Error("Unable to add runload (Error: $err)\n$msg") if $err;
+ } # if
+
+ return ($dberr, $dbmsg);
+} # TrimStorage
+
+sub ValidateCCObjects() {
+ my ($self) = @_;
+
+ my $vobRecordsDeleted = 0;
+ my $viewRecordsDeleted = 0;
+
+ for my $region ($Clearcase::CC->regions) {
+ for my $type (qw(vob view)) {
+ my @ccobjs;
+ verbose "Processing ${type}s in $region";
+
+ if ($type eq 'vob') {
+ verbose "Finding all vobs in region $region";
+ @ccobjs = $self->FindVob(undef, $region);
+ verbose 'Found ' . scalar @ccobjs . ' vobs to process';
+ } elsif ($type eq 'view') {
+ verbose "Finding all views in region $region";
+ @ccobjs = $self->FindView(undef, $region);
+ verbose 'Found ' . scalar @ccobjs . ' views to process';
+ } # if
+
+ for my $object (@ccobjs) {
+ my %ccobjrec = %$object;
+
+ verbose "Processing $ccobjrec{tag}:$ccobjrec{region}";
+
+ my $ccobj;
+
+ if ($type eq 'vob') {
+ $ccobj = Clearcase::Vob->new($ccobjrec{tag}, $ccobjrec{region});
+ } else {
+ $ccobj = Clearcase::View->new($ccobjrec{tag}, $ccobjrec{region});
+ } # if
+
+ verbose_nolf 'Checking if ' . $ccobj->{tag} . ':' . $ccobj->{region} . ' exists anymore...';
+
+ if ($ccobj->exists) {
+ verbose ' it does! Skipping...';
+ next;
+ } else {
+ verbose ' it doesn\'t!';
+ } # if
+
+ #next if $ccobj->exists;
+
+ verbose "Deleting $type $ccobjrec{tag}:$ccobjrec{region}";
+
+ my ($recordsDeleted, $msg) = $self->_deleteRecord($type,
+ "tag='$ccobjrec{tag}' and region='$ccobjrec{region}'");
+
+ if ($msg ne 'Records deleted') {
+ return ($recordsDeleted, $msg);
+ } else {
+ $viewRecordsDeleted += $recordsDeleted if $type eq 'view';
+ $vobRecordsDeleted += $recordsDeleted if $type eq 'vob';
+ } # if
+ } # for
+ } # for
+ } # for
+
+ return ($viewRecordsDeleted, $vobRecordsDeleted);
+} # ValidateCCObjects
+
sub GetFS($$;$$$$) {
my ($self, $system, $filesystem, $start, $end, $count, $interval) = @_;
$system = $self->_aliasSystem($system);
- return
- unless $system;
-
- return
- unless $filesystem;
+ return unless $system;
+ return unless $filesystem;
$interval ||= 'Minute';
$system = $self->_aliasSystem($system);
- return
- unless $system;
-
- return
- unless $filesystem;
+ return unless $system;
+ return unless $filesystem;
my @records = $self->_getRecords(
'fs',
);
if ($records[0]) {
- return %{$records[0]};
+ return %{$records[0]};
} else {
- return;
+ return;
} # if
} # GetLatestFS
my $result = _checkRequiredFields \@requiredFields, \%loadavg;
- return -1, "AddLoadavg: $result"
- if $result;
+ return -1, "AddLoadavg: $result" if $result;
# Timestamp record
$loadavg{timestamp} = Today2SQLDatetime;
$system = $self->_aliasSystem($system);
- return
- unless $system;
+ return unless $system;
$interval ||= 'Minute';
my $offset = $nbrRecs - $count;
# Offsets of < 0 are not allowed.
- $offset = 0
- if $offset < 0;
+ $offset = 0 if $offset < 0;
$condition .= " limit $offset, $count";
} # if
$system = $self->_aliasSystem($system);
- return
- unless $system;
+ return unless $system;
my @records = $self->_getRecords(
'loadavg',
} # if
} # GetLatestLoadavg
-sub GetStorage($$$;$$$$$) {
+sub GetStoragePool($$$;$$$$$) {
my ($self, $type, $tag, $storage, $region, $start, $end, $count, $interval) = @_;
$interval ||= 'Day';
undef $start if $start and $start =~ /earliest/i;
undef $end if $end and $end =~ /latest/i;
+ # Windows vob tags begin with "\", which is problematic. The solution is to
+ # escape the "\"
+ $tag =~ s/^\\/\\\\/;
+
my $condition;
my $table = $type eq 'vob' ? 'vobstorage' : 'viewstorage';
} # while
return @records;
-} # GetStorage
+} # GetStoragePool
sub AddTask(%) {
my ($self, %task) = @_;
my $result = _checkRequiredFields \@requiredFields, \%task;
- return -1, "AddTask: $result"
- if $result;
+ return -1, "AddTask: $result" if $result;
return $self->_addRecord('task', %task);
} # AddTask
sub GetTask($) {
my ($self, $name) = @_;
- return
- unless $name;
+ return unless $name;
my @records = $self->_getRecords('task', "name='$name'");
my $result = _checkRequiredFields \@requiredFields, \%schedule;
- return -1, "AddSchedule: $result"
- if $result;
+ return -1, "AddSchedule: $result" if $result;
return $self->_addRecord('schedule', %schedule);
} # AddSchedule
my ($self, $name, $task) = @_;
$name ||= '';
- $task||= '';
+ $task ||= '';
my $condition = "name like '%$name%'";
$condition .= ' and ';
my $result = _checkRequiredFields \@requiredFields, \%runlog;
- return -1, "AddRunlog: $result"
- if $result;
+ return -1, "AddRunlog: $result" if $result;
$runlog{ended} = Today2SQLDatetime;
sub GetRunlog($) {
my ($self, $id) = @_;
- return
- unless $id;
+ return unless $id;
my @records = $self->_getRecords('runlog', "id=$id");
my $result = _checkRequiredFields \@requiredFields, \%alert;
- return -1, "AddAlert: $result"
- if $result;
+ return -1, "AddAlert: $result" if $result;
return $self->_addRecord('alert', %alert);
} # AddAlert
# If you want to fake an alert in the debugger just change $diff accordingly
my $diff = Compare($today, $lastnotified);
- return
- if $diff <= 0;
+ return if $diff <= 0;
} # if
my $when = Today2SQLDatetime;
my %system = $self->GetSystem($system);
- return
- unless $system;
+ return unless $system;
if ($system{notification} and
$system{notification} eq 'Filesystem' and
# If we've never heard from this system then we will assume that the system
# has not been set up to run clearagent and has never checked in. In any event
# we cannot say the system died because we've never known it to be alive!
- return 1
- unless $system{lastheardfrom};
+ return 1 unless $system{lastheardfrom};
# If a system is not active (may have been temporarily been deactivated) then
# we don't want to turn on the bells and whistles alerting people it's down.
- return 1
- if $system{active} eq 'false';
+ return 1 if $system{active} eq 'false';
my $today = Today2SQLDatetime;
my $lastheardfrom = $system{lastheardfrom};
my $result = _checkRequiredFields \@requiredFields, \%alertlog;
- return -1, "AddAlertlog: $result"
- if $result;
+ return -1, "AddAlertlog: $result" if $result;
# Timestamp record
$alertlog{timestamp} = Today2SQLDatetime;
$condition .= "notification like '%$notification%'";
$condition .= " order by timestamp desc";
- if (defined $start) {
- $page ||= 10;
- $condition .= " limit $start, $page";
- } # unless
+ if (defined $start) {
+ $page ||= 10;
+ $condition .= " limit $start, $page";
+ } # unless
return $self->_getRecords('alertlog', $condition);
} # FindAlertLog
sub GetAlertlog($) {
my ($self, $alert) = @_;
- return
- unless $alert;
+ return unless $alert;
my @records = $self->_getRecords('alertlog', "alert='$alert'");
my $result = _checkRequiredFields \@requiredFields, \%notification;
- return -1, "AddNotification: $result"
- if $result;
+ return -1, "AddNotification: $result" if $result;
return $self->_addRecord('notification', %notification);
} # AddNotification
sub GetNotification($) {
my ($self, $name) = @_;
- return
- unless $name;
+ return unless $name;
my @records = $self->_getRecords('notification', "name='$name'");
use base 'Exporter';
-use CGI qw (
+use CGI qw(
:standard
start_a
end_a
our $VERSION = '$Revision: 1.46 $';
($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
-our @EXPORT = qw (
+our @EXPORT = qw(
autoScale
displayError
displayAlert
'Days',
);
-sub dbug ($) {
+sub dbug($) {
my ($msg) = @_;
display font ({-class => 'error'}, '<br>DEBUG: '). $msg;
return;
} # dbug
-sub displayError ($) {
+sub displayError($) {
my ($msg) = @_;
display font ({-class => 'error'}, 'Error: ') . $msg;
return
} # displayError;
-sub setField ($;$) {
+sub setField($;$) {
my ($field, $label) = @_;
$label ||= 'Unknown';
return defined $field ? $field : $undef;
} # setField
-sub setFields ($%) {
+sub setFields($%) {
my ($label, %rec) = @_;
$rec{$_} = setField ($rec{$_}, $label)
return %rec;
} # setFields;
-sub dumpVars (%) {
+sub dumpVars(%) {
my (%vars) = @_;
for (keys %vars) {
return;
} # dumpVars
-sub graphError ($) {
+sub graphError($) {
my ($msg) = @_;
use GD;
exit;
} # graphError
-sub autoScale ($) {
+sub autoScale($) {
my ($amount) = @_;
my $kbyte = 1024;
return $size;
} # autoScale
-sub _makeAlertlogSelection ($$) {
+sub _makeAlertlogSelection($$) {
my ($name, $default) = @_;
$default ||= 'All';
return $dropdown;
} # _makeAlertlogSelection
-sub _makeRunlogSelection ($$) {
+sub _makeRunlogSelection($$) {
my ($name, $default) = @_;
$default ||= 'All';
return $dropdown;
} # _makeRunlogSelection
-sub _makeRunlogSelectionNumeric ($$) {
+sub _makeRunlogSelectionNumeric($$) {
my ($name, $default) = @_;
$default ||= 'All';
return $dropdown;
} # _makeRunlogSelection
-sub makeAlertDropdown (;$$) {
+sub makeAlertDropdown(;$$) {
my ($label, $default) = @_;
$label ||= '';
my @values;
- push @values, $$_{name}
- for ($clearadm->FindAlert);
+ push @values, $$_{name} for ($clearadm->FindAlert);
my $dropdown = "$label ";
$dropdown .= popup_menu {
return $dropdown;
} # makeAlertDropdown
-sub makeMultiplierDropdown (;$$) {
+sub makeMultiplierDropdown(;$$) {
my ($label, $default) = @_;
$label ||= '';
return $dropdown;
} # makeMultiplierDropdown
-sub makeNoMoreThanDropdown (;$$) {
+sub makeNoMoreThanDropdown(;$$) {
my ($label, $default) = @_;
$label ||= '';
my @values;
- my $dropdown = 'Storage pool ';
+ my $dropdown = 'Storage pool ';
if ($type eq 'vob') {
push @values, qw(admin db cleartext derivedobj source total);
return span {id => $type}, $dropdown;
} # makeStoragePoolsDropdown
-sub makeFilesystemDropdown ($;$$$) {
+sub makeFilesystemDropdown($;$$$) {
my ($system, $label, $default, $onchange) = @_;
$label ||= '';
return span {id => 'filesystems'}, $dropdown;
} # makeFilesystemDropdown
-sub makeIntervalDropdown (;$$$) {
+sub makeIntervalDropdown(;$$$) {
my ($label, $default, $onchange) = @_;
$label ||= '';
'Month',
);
- $default = ucfirst lc $default
- if $default;
+ $default = ucfirst lc $default if $default;
my $dropdown = "$label ";
$dropdown .= popup_menu {
return span {id => 'scaling'}, $dropdown;
} # makeIntervalDropdown;
-sub makeNotificationDropdown (;$$) {
+sub makeNotificationDropdown(;$$) {
my ($label, $default) = @_;
$label ||= '';
return $dropdown;
} # makeNotificationDropdown
-sub makeRestartableDropdown (;$$) {
+sub makeRestartableDropdown(;$$) {
my ($label, $default) = @_;
$label ||= '';
return $dropdown;
} # makeRestartableDropdown
-sub makeSystemDropdown (;$$$%) {
+sub makeSystemDropdown(;$$$%) {
my ($label, $default, $onchange, %systems) = @_;
$label ||= '';
return span {id => 'systems'}, $systemDropdown;
} # makeSystemDropdown
-sub makeTaskDropdown (;$$) {
+sub makeTaskDropdown(;$$) {
my ($label, $default) = @_;
$label ||= '';
return $taskDropdown;
} # makeTaskDropdown
-sub makeTimeDropdown ($$$;$$$$$) {
+sub makeTimeDropdown($$$;$$$$$) {
my (
$table,
$elementID,
return $timeDropdown;
} # makeTimeDropdown
-sub heading (;$$) {
+sub heading(;$$) {
my ($title, $type) = @_;
if ($title) {
display header;
display start_html {
- -title => $title,
-
-author => 'Andrew DeFaria <Andrew@ClearSCM.com>',
- -meta => {
- keywords => 'ClearSCM Clearadm',
+ -title => $title,
+ -author => 'Andrew DeFaria <Andrew@ClearSCM.com>',
+ -meta => {
+ keywords => 'ClearSCM Clearadm',
copyright => 'Copyright (c) ClearSCM, Inc. 2010, All rights reserved',
- },
- -script => [{
- -language => 'JavaScript',
- -src => 'clearadm.js',
- }],
- -style => ['clearadm.css', 'clearmenu.css'],
+ },
+ -script => [{
+ -language => 'JavaScript',
+ -src => 'clearadm.js',
+ }],
+ -style => ['clearadm.css', 'clearmenu.css'],
}, $title;
return if $type;
return;
} # heading
-sub displayAlert (;$) {
+sub displayAlert(;$) {
my ($alert) = @_;
display start_table {cellspacing => 1};
return;
} # DisplayAlerts
-sub displayAlertlog (%) {
+sub displayAlertlog(%) {
my (%opts) = @_;
my $optsChanged;
return;
} # displayAlertlog
-sub displayFilesystem ($) {
+sub displayFilesystem($) {
my ($systemName) = @_;
display start_table {cellspacing => 1, width => '98%'};
display td {class => $classRightTop}, "$used ($usedPct%)<br>",
font {class => 'unknown'}, "$fs{timestamp}";
display td {class => $classRightTop}, "$filesystem{threshold}%";
+
+ my $image = $filesystem{fssmall}
+ ? "data:image/png;base64,$filesystem{fssmall}"
+ : "plotfs.cgi?system=$system{name}&filesystem=$filesystem{filesystem}&tiny=1";
+
display td {class => $class},
a {href =>
"plot.cgi?type=filesystem&system=$system{name}"
. "&filesystem=$filesystem{filesystem}&scaling=Day&points=7"
}, img {
- src => "plotfs.cgi?system=$system{name}"
- . "&filesystem=$filesystem{filesystem}&tiny=1",
+ src => $image,
border => 0,
};
display end_Tr;
return;
} # displayFilesystem
-sub displayNotification (;$) {
+sub displayNotification(;$) {
my ($notification) = @_;
display start_table {cellspacing => 1};
return;
} # displayNotification
-sub displayRunlog (%) {
+sub displayRunlog(%) {
my (%opts) = @_;
my $optsChanged;
return;
} # displayRunlog
-sub displaySchedule () {
+sub displaySchedule() {
display start_table {cellspacing => 1};
display start_Tr;
return;
} # displaySchedule
-sub displaySystem ($) {
+sub displaySystem($) {
my ($systemName) = @_;
my %system = $clearadm->GetSystem ($systemName);
a {href =>
"plot.cgi?type=loadavg&system=$system{name}&scaling=Hour&points=24"
}, img {
- src => "plotloadavg.cgi?system=$system{name}&tiny=1",
+ src => "data:image/png;base64,$system{loadavgsmall}",
border => 0,
};
my $classRight = $class . 'Right';
display start_Tr;
- display start_td {class => 'data'};
+ display start_td {class => 'data'};
- my $areYouSure = 'Are you sure you want to delete '
- . "$system{name}:$filesystem{filesystem}?" . '\n'
- . 'Doing so will remove all records related to this\n'
- . 'filesystem and its history.';
+ my $areYouSure = 'Are you sure you want to delete '
+ . "$system{name}:$filesystem{filesystem}?" . '\n'
+ . 'Doing so will remove all records related to this\n'
+ . 'filesystem and its history.';
- display start_form {
- method => 'post',
- action => 'processfilesystem.cgi',
- };
+ display start_form {
+ method => 'post',
+ action => 'processfilesystem.cgi',
+ };
- display input {
- type => 'hidden',
- name => 'system',
- value => $system{name},
- };
- display input {
- type => 'hidden',
- name => 'filesystem',
- value => $filesystem{filesystem},
- };
+ display input {
+ type => 'hidden',
+ name => 'system',
+ value => $system{name},
+ };
+ display input {
+ type => 'hidden',
+ name => 'filesystem',
+ value => $filesystem{filesystem},
+ };
- display input {
- name => 'delete',
- type => 'image',
- src => 'delete.png',
- alt => 'Delete',
- value => 'Delete',
- title => 'Delete',
- onclick => "return AreYouSure ('$areYouSure');"
- };
- display input {
- name => 'edit',
- type => 'image',
- src => 'edit.png',
- alt => 'Edit',
- value => 'Edit',
- title => 'Edit',
+ display input {
+ name => 'delete',
+ type => 'image',
+ src => 'delete.png',
+ alt => 'Delete',
+ value => 'Delete',
+ title => 'Delete',
+ onclick => "return AreYouSure ('$areYouSure');"
+ };
+ display input {
+ name => 'edit',
+ type => 'image',
+ src => 'edit.png',
+ alt => 'Edit',
+ value => 'Edit',
+ title => 'Edit',
+ };
+
+ if ($filesystem{notification}) {
+ display a {
+ href => "alertlog.cgi?system=$filesystem{system}"}, img {
+ src => 'alert.png',
+ border => 0,
+ alt => 'Alert!',
+ title => 'This filesystem has alerts',
};
+ } # if
- if ($filesystem{notification}) {
- display a {
- href => "alertlog.cgi?system=$filesystem{system}"}, img {
- src => 'alert.png',
- border => 0,
- alt => 'Alert!',
- title => 'This filesystem has alerts',
- };
- } # if
+ display end_form;
- display end_form;
display td {class => $class}, $filesystem{filesystem};
display td {class => $classCentered}, $filesystem{fstype};
display td {class => $class}, $filesystem{mount};
. "&filesystem=$filesystem{filesystem}"
. "&scaling=Day&points=7"
}, img {
- src => "plotfs.cgi?system=$system{name}&"
- . "filesystem=$filesystem{filesystem}"
- . '&tiny=1',
- border => 0,
+ src => "data:image/png;base64,$filesystem{fssmall}",
+ border => 0,
};
display end_Tr;
} # for
return;
} # displaySystem
-sub displayTask (;$) {
+sub displayTask(;$) {
my ($task) = @_;
display start_table {cellspacing => 1, width => '98%'};
return;
} # DisplayAlerts
-sub editAlert (;$) {
+sub editAlert(;$) {
my ($alert) = @_;
display start_form (
return;
} # editAlert
-sub editFilesystem ($$) {
+sub editFilesystem($$) {
my ($system, $filesystem) = @_;
display start_form (
return;
} # editFilesytem
-sub editNotification (;$) {
+sub editNotification(;$) {
my ($notification) = @_;
display start_form (
return;
} # editNotification
-sub editSchedule (;$) {
+sub editSchedule(;$) {
my ($schedule) = @_;
display start_form (
return;
} # editSchedule
-sub editSystem (;$) {
+sub editSystem(;$) {
my ($system) = @_;
display start_form (
return;
} # editSystem
-sub editTask (;$) {
+sub editTask(;$) {
my ($task) = @_;
display start_form (
return;
} # editTask
-sub footing () {
+sub footing() {
my $clearscm = a {-href => 'http://clearscm.com'}, 'ClearSCM, Inc.';
# Figure out which script by using CLEARADM_BASE.
$CLEAROPTS{CLEAREXEC_MULTITHREADED} = $ENV{CLEAREXEC_MULTITHREADED}
if $ENV{CLEAREXEC_MULTITHREADED};
-sub new () {
+sub new() {
my ($class) = @_;
my $clearadm = bless {}, $class;
return $clearadm;
} # new
-sub _tag ($) {
+sub _tag($) {
my ($self, $msg) = @_;
my $tag = YMDHMS;
return "$tag$msg";
} # _tag
-sub _verbose ($) {
+sub _verbose($) {
my ($self, $msg) = @_;
verbose $self->_tag ($msg);
return;
} # _verbose
-sub _debug ($) {
+sub _debug($) {
my ($self, $msg) = @_;
debug $self->_tag ($msg);
return;
} # _debug
-sub _log ($) {
+sub _log($) {
my ($self, $msg) = @_;
display $self->_tag ($msg);
return;
} # log
-sub _endServer () {
+sub _endServer() {
display "Clearexec V$VERSION shutdown at " . localtime;
# Kill process group
# Wait for all children to die
while (wait != -1) {
-
# do nothing
} # while
exit;
} # _endServer
-sub _restartServer () {
+sub _restartServer() {
# Not sure what to do on a restart server
display 'Entered _restartServer';
return;
} # _restartServer
-sub setMultithreaded ($) {
+sub setMultithreaded($) {
my ($self, $value) = @_;
my $oldValue = $self->{multithreaded};
return $oldValue;
} # setMultithreaded
-sub getMultithreaded () {
+sub getMultithreaded() {
my ($self) = @_;
return $self->{multithreaded};
} # getMultithreaded
-sub connectToServer (;$$) {
+sub connectToServer(;$$) {
my ($self, $host, $port) = @_;
$host ||= $CLEAROPTS{CLEAREXEC_HOST};
return unless $self->{socket};
- $self->{socket}->autoflush
- if $self->{socket};
+ $self->{socket}->autoflush if $self->{socket};
$self->{host} = $host;
$self->{port} = $port;
return;
} # connectToServer
-sub disconnectFromServer () {
+sub disconnectFromServer() {
my ($self) = @_;
undef $self->{socket};
return;
} # disconnectFromServer
-sub execute ($) {
+sub execute($) {
my ($self, $cmd) = @_;
- return (-1, 'Unable to talk to server')
- unless $self->{socket};
+ return (-1, 'Unable to talk to server') unless $self->{socket};
my ($status, $statusLine, @output) = (-1, '', ());
return ($status, @output);
} # execute
-sub _serviceClient ($$) {
+sub _serviceClient($$) {
my ($self, $host, $client) = @_;
$self->_verbose ("Serving requests from $host");
# Set autoflush for client
- $client->autoflush
- if $client;
+ $client->autoflush if $client;
while () {
# Read command from client
$self->_debug ("Returning 0, undef");
} else {
# Combines STDERR -> STDOUT if not already specified
- $cmd .= ' 2>&1'
- unless $cmd =~ /2>&1/;
+ $cmd .= ' 2>&1' unless $cmd =~ /2>&1/;
$self->_debug ("Executing $cmd");
($status, @output) = Execute $cmd;
return;
} # _serviceClient
-sub startServer (;$) {
+sub startServer(;$) {
my ($self, $port) = @_;
$port ||= $CLEAROPTS{CLEAREXEC_PORT};
Reuse => 1
);
- error "Could not create socket - $!", 1
- unless $self->{socket};
+ error "Could not create socket - $!", 1 unless $self->{socket};
# Announce ourselves
$self->_log ("Clearexec V$VERSION accepting clients at " . localtime);
'1 year'
) not null default '6 months',
loadavgThreshold float (4,2) default 5.00,
+ loadavgsmall blob,
+ loadavg blob,
primary key (name)
) engine=innodb; -- system
'11 months',
'1 year'
) not null default '6 months',
+ fssmall blob,
+ fslarge blob,
key filesystemIndex (filesystem),
foreign key systemLink (system) references system (name)
-- vobstorage: Contains a snapshot of a vob's storage pools at a given date
-- and time
create table vobstorage (
- tag varchar(255) not null,
- region varchar(255) not null,
- timestamp datetime not null,
- admin decimal(10,1),
- db decimal(10,1),
- cleartext decimal(10,1),
- derivedobj decimal(10,1),
- source decimal(10,1),
- total decimal(10,1),
+ tag varchar(255) not null,
+ region varchar(255) not null,
+ timestamp datetime not null,
+ admin decimal(10,1),
+ db decimal(10,1),
+ cleartext decimal(10,1),
+ derivedobj decimal(10,1),
+ source decimal(10,1),
+ total decimal(10,1),
- key vobtagIndex (tag),
+ key vobtagIndex (tag, region),
primary key (tag, region, timestamp)
+ foreign key vobLink (tag, region)
+ references vob (tag, region)
+ on delete cascade
+ on update cascade
) engine=innodb; -- vobstorage
-- viewstorage: Contains a snapshot of a view's storage pools at a given date
admin decimal(10,1),
total decimal(10,1),
- key viewtagIndex (tag),
- primary key (tag, region, timestamp)
+ key viewtagIndex (tag, region),
+ primary key (tag, region, timestamp),
+ foreign key viewLink (tag, region)
+ references view (tag, region)
+ on delete cascade
+ on update cascade
) engine=innodb; -- viewstorage
-- loadavg: Contains a snapshot reading of a system's load average
on update cascade
) engine=innodb; -- loadavg
--- vobs: Describe a system's vobs
+-- vob: Describe a system's vobs
create table vob (
- system varchar (255) not null,
- tag varchar (255) not null,
+ tag varchar (255) not null,
+ region varchar (255) not null,
+ adminsmall blob,
+ dbsmall blob,
+ cleartextsmall blob,
+ derivedobjsmall blob,
+ sourcesmall blob,
+ totalsmall blob,
+ adminlarge blob,
+ dblarge blob,
+ cleartextlarge blob,
+ derivedobjlarge blob,
+ sourcelarge blob,
+ totallarge blob,
- key systemIndex (system),
- foreign key systemLink (system) references system (name)
- on delete cascade
- on update cascade,
- primary key (tag)
+ key vobTagIndex (tag),
+ primary key (tag, region)
) engine=innodb; -- vob
-- view: Describe views
create table view (
- system varchar (255) not null,
- region varchar (255) not null,
- tag varchar (255) not null,
- owner tinytext,
- ownerName tinytext,
- email tinytext,
- type enum (
- 'dynamic',
- 'snapshot',
- 'web'
- ) not null default 'dynamic',
- gpath tinytext,
- modified datetime,
- timestamp datetime,
- age tinytext,
- ageSuffix tinytext,
+ tag varchar (255) not null,
+ region varchar (255) not null,
+ owner tinytext,
+ ownerName tinytext,
+ email tinytext,
+ type enum (
+ 'dynamic',
+ 'snapshot',
+ 'web'
+ ) not null default 'dynamic',
+ gpath tinytext,
+ modified datetime,
+ timestamp datetime,
+ age tinytext,
+ ageSuffix tinytext,
+ privatesmall blob,
+ dbsmall blob,
+ adminsmall blob,
+ totalsmall blob,
+ privatelarge blob,
+ dblarge blob,
+ adminlarge blob,
+ totallarge blob,
- key systemIndex (system),
- foreign key systemLink (system) references system (name)
- on delete cascade
- on update cascade,
- key regionIndex (region),
- primary key (region, tag)
+ key viewTagIndex (tag),
+ primary key (tag, region)
) engine=innodb; -- view
create table task (
use warnings;
use FindBin;
-use CGI qw (:standard :cgi-lib start_table end_table start_Tr end_Tr);
+use CGI qw(:standard :cgi-lib start_table end_table start_Tr end_Tr);
use GD::Graph::area;
use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib";
my $clearadm;
-sub displayGraph () {
+sub displayGraph() {
my $parms;
for (keys %opts) {
display '<center>';
if ($opts{type} eq 'loadavg') {
- unless ($opts{tiny}) {
- display img {src => "plotloadavg.cgi?$parms", class => 'chart'};
+ my %system = $clearadm->GetSystem($opts{system});
+
+ # We can use the cached version only if the opts are set to default
+ if ($opts{scaling} eq 'Hour' and $opts{points} == 24) {
+ my $data = $opts{tiny} ? $system{loadavgsmall} : $system{loadavg};
+
+ display img {src => "data:image/png;base64,$data"};
} else {
- display img {src => "plotloadavg.cgi?$parms", border => 0};
- } # unless
+ unless ($opts{tiny}) {
+ display img {src => "plotloadavg.cgi?$parms", class => 'chart'};
+ } else {
+ display img {src => "plotloadavg.cgi?$parms", border => 0};
+ } # unless
+ } # if
} elsif ($opts{type} eq 'filesystem') {
- unless ($opts{tiny}) {
- display img {src => "plotfs.cgi?$parms", class => 'chart'};
+ my %filesystem = $clearadm->GetFilesystem($opts{system}, $opts{filesystem});
+
+ # We can use the cached version only if the opts are set to default
+ if ($opts{scaling} eq 'Day' and $opts{points} == 7) {
+ my $data = $opts{tiny} ? $filesystem{fssmall} : $filesystem{fslarge};
+
+ display img {src => "data:image/png;base64,$data"};
} else {
- display img {src => "plotfs.cgi?$parms", border => 0};
- } # unless
+ unless ($opts{tiny}) {
+ display img {src => "plotfs.cgi?$parms", class => 'chart'};
+ } else {
+ display img {src => "plotfs.cgi?$parms", border => 0};
+ } # unless
+ } # if
} elsif ($opts{type} eq 'vob' or $opts{type} eq 'view') {
- unless ($opts{tiny}) {
- display img {src => "plotstorage.cgi?$parms", class => 'chart'};
+ my (%vob, %view);
+
+ %vob = $clearadm->GetVob($opts{tag}, $opts{region}) if $opts{type} eq 'vob';
+ %view = $clearadm->GetView($opts{tag}, $opts{region}) if $opts{type} eq 'view';
+ # We can use the cached version only if the opts are set to default
+ if ($opts{scaling} eq 'Day' and $opts{points} == 7) {
+ my $storageType = $opts{tiny} ? "$opts{storage}small" : "$opts{storage}large";
+ my $data = $opts{type} eq 'vob' ? $vob{$storageType} : $view{$storageType};
+
+ display img {src => "data:image/png;base64,$data"};
} else {
- display img {src => "plotstorage.cgi?$parms", border => 0};
- } # unless
+ unless ($opts{tiny}) {
+ display img {src => "plotstorage.cgi?$parms", class => 'chart'};
+ } else {
+ display img {src => "plotstorage.cgi?$parms", border => 0};
+ } # unless
+ } # if
} # if
display '</center>';
- return
+ return;
} # displayGraph
-sub displayFSInfo () {
+sub displayFSInfo() {
if ($opts{filesystem}) {
display h3 {-align => 'center'}, 'Latest Filesystem Reading';
} else {
- display p;
- return;
+ display p;
+ return;
} # if
display start_table {width => '800px', cellspacing => 1};
my ($systemLink, $systemButtons);
if ($opts{type} =~ /(vob|view)/i) {
- $tagsButtons = makeTagsDropdown ($opts{type}, $opts{tag});
+ $tagsButtons = makeTagsDropdown($opts{type}, $opts{tag});
} else {
$systemLink = span {id => 'systemLink'}, a {
href => "systemdetails.cgi?system=$opts{system}",
}, 'System';
- $systemButtons = makeSystemDropdown (
+ $systemButtons = makeSystemDropdown(
$systemLink,
$opts{system},
'updateFilesystems(this.value);updateSystemLink(this.value)'
);
} # if
- my $startButtons = makeTimeDropdown (
+ my $startButtons = makeTimeDropdown(
$opts{type},
'startTimestamp',
$opts{system},
$opts{scaling},
);
- my $endButtons = makeTimeDropdown (
+ my $endButtons = makeTimeDropdown(
$opts{type},
'endTimestamp',
$opts{system},
$update = ''; # TODO do I need something here?
} # if
- my $intervalButtons = makeIntervalDropdown (
+ my $intervalButtons = makeIntervalDropdown(
'Interval',
$opts{scaling},
$update
$clearadm = Clearadm->new;
-my $title = ucfirst ($opts{type}) . ': ';
+my $title = ucfirst($opts{type}) . ': ';
$title .= ucfirst $opts{system} if $opts{system};
$title .= ":$opts{filesystem}" if $opts{filesystem};
};
# Some hidden fields to pass along
-display input {type => 'hidden', name => 'type', value => $opts{type}};
+display input {type => 'hidden', name => 'type', value => $opts{type}};
+display input {type => 'hidden', name => 'region', value => $opts{region}};
displayGraph;
displayFSInfo;
use warnings;
use FindBin;
+use Convert::Base64;
use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib";
use ClearadmWeb;
use Display;
-use CGI qw (:standard :cgi-lib);
+use CGI qw(:standard :cgi-lib);
use GD::Graph::area;
my %opts = Vars;
my $clearadm = Clearadm->new;
-my $graph = GD::Graph::area->new ($opts{width}, $opts{height});
+my $graph = GD::Graph::area->new($opts{width}, $opts{height});
graphError "System is required"
unless $opts{system};
graphError "Points not numeric (points: $opts{points})"
if $opts{points} and $opts{points} !~ /^\d+$/;
-my @fs = $clearadm->GetFS (
+my @fs = $clearadm->GetFS(
$opts{system},
$opts{filesystem},
$opts{start},
my $i = 0;
-foreach (@fs) {
+for (@fs) {
$i++;
my %fs = %{$_};
push @y, $opts{meg} ? $fs{used} / (1024 * 1024) :
$fs{used} / (1024 * 1024 * 12024);
-}
+} # for
+
my @data = ([@x], [@y]);
my $x_label_skip = @x > 1000 ? 200
. "$opts{system}:$opts{filesystem}";
my $labelY = $opts{tiny} ? '' : '%.2f';
-$graph->set (
+$graph->set(
x_label =>$x_label,
x_labels_vertical => 1,
x_label_skip => $x_label_skip,
my $image = $graph->plot(\@data)
or croak $graph->error;
-print "Content-type: image/png\n\n";
-print $image->png;
+unless ($opts{generate}) {
+ print "Content-type: image/png\n\n";
+ print $image->png;
+} else {
+ print encode_base64 $image->png;
+} # unless
=pod
use warnings;
use FindBin;
+use Convert::Base64;
use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib";
use ClearadmWeb;
use Display;
-use CGI qw (:standard :cgi-lib);
+use CGI qw(:standard :cgi-lib);
use GD::Graph::area;
my %opts = Vars;
my $clearadm = Clearadm->new;
-my $graph = GD::Graph::area->new ($opts{width}, $opts{height});
+my $graph = GD::Graph::area->new($opts{width}, $opts{height});
graphError "System is required"
unless $opts{system};
graphError "Points not numeric (points: $opts{points})"
if $opts{points} and $opts{points} !~ /^\d+$/;
-my @loads = $clearadm->GetLoadavg (
+my @loads = $clearadm->GetLoadavg(
$opts{system},
$opts{start},
$opts{end},
$opts{points},
- $opts{scaling}
+ $opts{scaling},
);
graphError "No loadavg data"
my (@x, @y);
-foreach (@loads) {
+for (@loads) {
my %load = %{$_};
if ($opts{tiny}) {
} # if
push @y, $load{loadavg};
-} # foreach
+} # for
my @data = ([@x], [@y]);
my $title = $opts{tiny} ? '' : "Load Average for $opts{system}";
my $labelY = $opts{tiny} ? '' : '%.2f';
-$graph->set (
+$graph->set(
x_label => $x_label,
x_labels_vertical => 1,
x_label_skip => $x_label_skip,
my $image = $graph->plot(\@data)
or croak $graph->error;
-print "Content-type: image/png\n\n";
-print $image->png;
+unless ($opts{generate}) {
+ print "Content-type: image/png\n\n";
+ print $image->png;
+} else {
+ print encode_base64 $image->png;
+} # unless
=pod
<storage>: Name of the Clearcase storage pool to plot information for
<height>: Height of chart (Default: 480px - tiny: 40)
<width>: Width of chart (Default: 800px - tiny: 150)
- <color>: A GD::Color color value (Default: lblue)
+ <color>: A GD::Color color value (Default: purple)
<scaling>: Currently one of Minute, Hour, Day or Month. Specifies how
Clearadm::GetFS will scale the data returned (Default: Minute
- tiny: Day)
use warnings;
use FindBin;
+use Convert::Base64;
use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib";
use Clearcase;
use Display;
-use CGI qw (:standard :cgi-lib);
+use CGI qw(:standard :cgi-lib);
use GD::Graph::area;
my %opts = Vars;
my $VERSION = '$Revision: 1.13 $';
($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
-$opts{color} ||= 'lblue';
+$opts{color} ||= $opts{type} eq 'vob' ? 'purple' : 'marine';
$opts{height} ||= 350;
$opts{width} ||= 800;
my $clearadm = Clearadm->new;
-my $graph = GD::Graph::area->new ($opts{width}, $opts{height});
+my $graph = GD::Graph::area->new($opts{width}, $opts{height});
graphError "Tag is required" unless $opts{tag};
graphError "Type is required" unless $opts{type};
graphError "Points not numeric (points: $opts{points})"
if $opts{points} and $opts{points} !~ /^\d+$/;
-my @storage = $clearadm->GetStorage (
+my @storage = $clearadm->GetStoragePool(
$opts{type},
$opts{tag},
$opts{storage},
. "$opts{type}:$opts{tag} $storageLabel";
my $labelY = $opts{tiny} ? '' : '%.2f';
-$graph->set (
+$graph->set(
x_label => $x_label,
x_labels_vertical => 1,
x_label_skip => $x_label_skip,
my $image = $graph->plot(\@data)
or croak $graph->error;
-print "Content-type: image/png\n\n";
-print $image->png;
+unless ($opts{generate}) {
+ print "Content-type: image/png\n\n";
+ print $image->png;
+} else {
+ print encode_base64 $image->png;
+} # unless
=pod
my $VERSION = '$Revision: 1.2 $';
($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
-sub restart ($) {\r
+sub restart($) {\r
my ($restart) = @_;
my ($status, @output) = Execute "$restart 2>&1";
unless ($status) {
display "Successfully executed restart option: $restart";
- display $_ foreach (@output);
+ display $_ for (@output);
} else {
display "Unable to restart process using $restart (Status: $status)";
- display $_ foreach (@output);
+ display $_ for (@output);
} # unless
return $status;
. join ("\n", @output), $status;
} # if
-foreach (@output) {
- next
- if /grep -i '$name'/;
-
- next
- if /grep -i $name/;
-
- next
- if /$FindBin::Script/;
+for (@output) {
+ next if /grep -i '$name'/;
+ next if /grep -i $name/;
+ next if /$FindBin::Script/;
display "Found processes named $name";
+
exit 0;
-} # foreach
+} # for
display "Did not find any processes named $name";
use FindBin;
use Getopt::Long;
-use CGI qw (:standard *table start_Tr end_Tr);
+use CGI qw(:standard *table start_Tr end_Tr);
use CGI::Carp 'fatalsToBrowser';
use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib";
use Utils;
# Main
-GetOptions (
+GetOptions(
'usage' => sub { Usage },
'verbose' => sub { set_verbose },
'debug' => sub { set_debug },
display h1 {class => 'center'}, "$ClearadmWeb::APPNAME: README";
-display $_
- foreach (ReadFile 'README');
+display $_ foreach (ReadFile 'README');
display '</pre></blockquote>';
my $VERSION = '$Revision: 1.1 $';
($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
-sub SetupAgent () {
+sub SetupAgent() {
verbose 'Setting up Agent...';
my ($status, @output, $cmd);
($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
- if $status;
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status if $status;
$cmd = "chmod 777 $Clearadm::CLEAROPTS{CLEARADM_BASE}/$_";
# Symlink $CLEARADM/etc/conf.d/clearadm -> /etc/init.d
my $confdir = '/etc/init.d';
- error "Cannot find conf.d directory ($confdir)", 1
- unless -d $confdir;
+ error "Cannot find conf.d directory ($confdir)", 1 unless -d $confdir;
unless (-e "$confdir/clearagent") {
$cmd = "ln -s $FindBin::Bin/etc/init.d/clearagent $confdir";
($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
- if $status;
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status if $status;
verbose 'Starting clearagent';
($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
- if $status;
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status if $status;
} else {
$cmd = 'update-rc.d clearagent defaults';
($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
- if $status;
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status if $status;
verbose 'Starting clearagent';
return;
} # SetupAgent
-sub SetupTasks () {
+sub SetupTasks() {
my ($status, @output, $cmd);
verbose 'Setting up Tasks...';
# Symlink $CLEARADM/etc/conf.d/cleartasks -> /etc/init.d
my $confdir = '/etc/init.d';
- error "Cannot find conf.d directory ($confdir)", 1
- unless -d $confdir;
+ error "Cannot find conf.d directory ($confdir)", 1 unless -d $confdir;
unless (-e "$confdir/clearadm") {
$cmd = "ln -s $FindBin::Bin/etc/init.d/cleartasks $confdir";
($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
- if $status;
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status if $status;
} # unless
# Setup runlevel links
($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
- if $status;
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status if $status;
verbose 'Starting cleartasks';
($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
- if $status;
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status if $status;
verbose 'Done';
return;
} # SetupTasks
-sub SetupWeb () {
+sub SetupWeb() {
verbose 'Setting up Web...';
my ($status, @output, $cmd);
# Symlink $CLEARADM/etc/conf.d/clearadm -> /etc/apache2/conf.d
my $confdir = '/etc/apache2/conf.d';
- error "Cannot find Apache 2 conf.d directory ($confdir)", 1
- unless -d $confdir;
+ error "Cannot find Apache 2 conf.d directory ($confdir)", 1 unless -d $confdir;
unless (-e "$confdir/clearadm") {
$cmd = "ln -s $FindBin::Bin/etc/conf.d/clearadm $confdir";
return;
} # SetupWeb
-sub SetupDatabase () {
+sub SetupDatabase() {
verbose 'Setting up Database';
my ($status, @output, $cmd);
($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
- if $status;
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status if $status;
verbose 'Setting up database users';
($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
- if $status;
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status if $status;
verbose 'Setting up predefined tasks';
($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
- if $status;
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status if $status;
verbose 'Done';
my $package = 'all';
-GetOptions (
+GetOptions(
usage => sub { Usage },
verbose => sub { set_verbose },
debug => sub { set_debug },
'package=s' => \$package,
) or Usage "Invalid parameter";
-Usage 'Extraneous options: ' . join ' ', @ARGV
- if @ARGV;
+Usage 'Extraneous options: ' . join ' ', @ARGV if @ARGV;
# Announce ourselves
verbose "$FindBin::Script V$VERSION";
use FindBin;
use Getopt::Long;
-use CGI qw (:standard :cgi-lib *table start_Tr end_Tr start_td end_td);
+use CGI qw(:standard :cgi-lib *table start_Tr end_Tr start_td end_td);
use CGI::Carp 'fatalsToBrowser';
use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib";
my $clearadm;
-sub DisplaySystems () {
+sub DisplaySystems() {
display start_table {cellspacing => 1, class => 'main'};
display start_Tr;
display th {class => 'labelCentered'}, 'Load Avg';
display end_Tr;
- foreach ($clearadm->FindSystem) {
+ for ($clearadm->FindSystem) {
my %system = %{$_};
$system{alias} = setField $system{alias}, 'N/A';
my $lastheardfromClass = 'dataCentered';
my $lastheardfromData = $system{lastheardfrom};
- unless ($clearadm->SystemAlive (%system)) {
+ unless ($clearadm->SystemAlive(%system)) {
$lastheardfromClass = 'dataCenteredAlert';
$lastheardfromData = a {
href => "alertlog.cgi?system=$system{name}",
display td {class => $classRightTop}, "$load{loadavg} ",
font {class => 'dim' }, "<br>$load{timestamp}";
display td {class => $classRightTop}, $system{loadavgThreshold};
+
+ my $image = $system{loadavgsmall}
+ ? "data:image/png;base64,$system{loadavgsmall}"
+ : "plotloadavg.cgi?system=$system{name}&tiny=1";
+
display td {class => $class},
a {
href =>
"plot.cgi?type=loadavg&system=$system{name}&scaling=Hour&points=24"
}, img {
- src => "plotloadavg.cgi?system=$system{name}&tiny=1",
+ src => $image,
border => 0,
};
display end_Tr;
- } # foreach
+ } # for
display end_table;
} # DisplaySystems
# Main
-GetOptions (
+GetOptions(
usage => sub { Usage },
verbose => sub { set_verbose },
debug => sub { set_debug },
my $clearadm = new Clearadm;
my %system = (
- name => 'jupiter',
- alias => 'defaria.com',
- admin => 'Andrew DeFaria',
- os => 'Linux defaria.com 2.6.32-25-generic-pae #45-Ubuntu SMP Sat Oct 16 21:01:33 UTC 2010 i686 GNU/Linux',
- type => 'Linux',
+ name => 'jupiter',
+ alias => 'defaria.com',
+ admin => 'Andrew DeFaria',
+ os => 'Linux defaria.com 2.6.32-25-generic-pae #45-Ubuntu SMP Sat Oct 16 21:01:33 UTC 2010 i686 GNU/Linux',
+ type => 'Linux',
description => 'Home server',
);
my %package = (
- 'system' => 'jupiter',
- 'name' => 'MySQL',
- 'version' => '5.1',
+ 'system' => 'jupiter',
+ 'name' => 'MySQL',
+ 'version' => '5.1',
);
my %update;
my %filesystem = (
- 'system' => 'jupiter',
+ 'system' => 'jupiter',
'filesystem' => '/dev/mapper/jupiter-root',
- 'fstype' => 'ext3',
- 'mount' => '/',
+ 'fstype' => 'ext3',
+ 'mount' => '/',
'threshold' => 90,
);
sub DisplayRecord (%) {
my (%record) = @_;
- foreach (keys %record) {
- if ($record{$_}) {
- display "$_: $record{$_}";
- } else {
- display "$_: <undef>";
- } # if
- } # foreach
+ for (keys %record) {
+ if ($record{$_}) {
+ display "$_: $record{$_}";
+ } else {
+ display "$_: <undef>";
+ } # if
+ } # for
} # DisplayRecord
-sub DisplayRecords (@) {
+sub DisplayRecords(@) {
my (@records) = @_;
- DisplayRecord %{$_}
- foreach (@records);
+ DisplayRecord %{$_} for (@records);
} # DisplayRecords
-sub TestSystem () {
+sub TestSystem() {
verbose "Adding system $system{name}";
- my ($err, $msg) = $clearadm->AddSystem (%system);
+ my ($err, $msg) = $clearadm->AddSystem(%system);
if ($err == 1062) {
warning 'You already have that record!';
} # if
verbose "Finding systems that match \'jup\'";
- DisplayRecords $clearadm->FindSystem ('jup');
+ DisplayRecords $clearadm->FindSystem('jup');
verbose "Getting record for \'jupiter\'";
- DisplayRecord $clearadm->GetSystem ('jupiter');
+ DisplayRecord $clearadm->GetSystem('jupiter');
verbose "Finding systems that match \'def\'";
- DisplayRecords $clearadm->FindSystem ('def');
+ DisplayRecords $clearadm->FindSystem('def');
verbose "Getting record for \'defaria.com\'";
- DisplayRecord $clearadm->GetSystem ('defaria.com');
+ DisplayRecord $clearadm->GetSystem('defaria.com');
%update = (
'region' => 'East Coast',
verbose "Updating system $system{name}";
- ($err, $msg) = $clearadm->UpdateSystem ($system{name}, %update);
+ ($err, $msg) = $clearadm->UpdateSystem($system{name}, %update);
- error $msg, $err
- if $err;
+ error $msg, $err if $err;
} # TestaSystem
-sub TestPackage () {
+sub TestPackage() {
verbose "Adding package $package{name}";
- my ($err, $msg) = $clearadm->AddPackage (%package);
+ my ($err, $msg) = $clearadm->AddPackage(%package);
if ($err == 1062) {
warning 'You already have that record!';
} # if
%update = (
- 'vendor' => 'ClearSCM',
- 'description' => 'This is not ClearSCM\'s version of MySQL',
+ 'vendor' => 'ClearSCM',
+ 'description' => 'This is not ClearSCM\'s version of MySQL',
);
verbose "Updating package $package{name}";
- ($err, $msg) = $clearadm->UpdatePackage ($package{system}, $package{name}, %update);
+ ($err, $msg) = $clearadm->UpdatePackage($package{system}, $package{name}, %update);
- error $msg, $err
- if $err;
+ error $msg, $err if $err;
verbose "Finding packages for $system{name} that match \'My\'";
- DisplayRecords $clearadm->FindPackage ($system{name}, 'My');
+ DisplayRecords $clearadm->FindPackage($system{name}, 'My');
verbose ("Getting package for $system{name} record for \'MySQL\'");
- DisplayRecord $clearadm->GetPackage ($system{name}, 'MySQL');
+ DisplayRecord $clearadm->GetPackage($system{name}, 'MySQL');
} # TestPackage
-sub TestFilesystem () {
+sub TestFilesystem() {
verbose "Adding filesystem $filesystem{filesystem}";
- my ($err, $msg) = $clearadm->AddFilesystem (%filesystem);
+ my ($err, $msg) = $clearadm->AddFilesystem(%filesystem);
- error $msg, $err
- if $err;
+ error $msg, $err if $err;
- $filesystem{filesystem} = '/dev/sda5';
- $filesystem{path} = '/disk2';
+ $filesystem{filesystem} = '/dev/sda5';
+ $filesystem{path} = '/disk2';
verbose "Adding filesystem $filesystem{filesystem}";
- ($err, $msg) = $clearadm->AddFilesystem (%filesystem);
+ ($err, $msg) = $clearadm->AddFilesystem(%filesystem);
- error $msg, $err
- if $err;
+ error $msg, $err if $err;
%update = (
- 'filesystem' => '/dev/sdb5',
+ 'filesystem' => '/dev/sdb5',
);
verbose "Updating filesystem $filesystem{filesystem}";
- ($err, $msg) = $clearadm->UpdateFilesystem (
+ ($err, $msg) = $clearadm->UpdateFilesystem(
$filesystem{system}, $filesystem{filesystem}, %update
);
- error $msg, $err
- if $err;
+ error $msg, $err if $err;
verbose "Finding filesystems for $system{name} that match \'My\'";
- DisplayRecords $clearadm->FindFilesystem ($system{name}, 'root');
+ DisplayRecords $clearadm->FindFilesystem($system{name}, 'root');
verbose ("Getting filesystem for $system{name} record for \'/dev/sdb5\'");
- DisplayRecord $clearadm->GetFilesystem ($system{name}, '/dev/sdb5');
+ DisplayRecord $clearadm->GetFilesystem($system{name}, '/dev/sdb5');
} # TestFilesystem
-sub TestVob () {
+sub TestVob() {
verbose "Adding vob $vob{tag}";
- my ($err, $msg) = $clearadm->AddVob (%vob);
+ my ($err, $msg) = $clearadm->AddVob(%vob);
- error $msg, $err
- if $err;
+ error $msg, $err if $err;
$vob{tag} = '/vobs/clearscm_old';
verbose "Adding vob $vob{tag}";
- ($err, $msg) = $clearadm->AddVob (%vob);
+ ($err, $msg) = $clearadm->AddVob(%vob);
- error $msg, $err
- if $err;
+ error $msg, $err if $err;
verbose "Finding vobs that match \'clearscm\'";
- DisplayRecords $clearadm->FindVob ('clearscm');
+ DisplayRecords $clearadm->FindVob('clearscm');
verbose ("Getting vob for \'clearscm\'");
- DisplayRecord $clearadm->GetVob ('clearscm');
+ DisplayRecord $clearadm->GetVob('clearscm');
} # TestVob
-sub TestView () {
+sub TestView() {
verbose "Adding view $view{tag}";
- my ($err, $msg) = $clearadm->AddView (%view);
+ my ($err, $msg) = $clearadm->AddView(%view);
- error $msg, $err
- if $err;
+ error $msg, $err if $err;
$view{tag} = 'andrew2_view';
verbose "Adding view $view{tag}";
- ($err, $msg) = $clearadm->AddView (%view);
+ ($err, $msg) = $clearadm->AddView(%view);
- error $msg, $err
- if $err;
+ error $msg, $err if $err;
verbose "Finding views that match \'andrew\'";
- DisplayRecords $clearadm->FindView ('andrew');
+ DisplayRecords $clearadm->FindView('andrew');
verbose ("Getting view for \'view\'");
- DisplayRecord $clearadm->GetView ('andrew');
+ DisplayRecord $clearadm->GetView('andrew');
} # TestView
TestSystem;
########################
verbose "Deleting system $system{name}";
-my ($err, $msg) = $clearadm->DeleteSystem ($system{name});
+my ($err, $msg) = $clearadm->DeleteSystem($system{name});
-error $msg, $err
- if $err;
-
+error $msg, $err if $err;
use DateUtils;
use Display;
use Utils;
+use TimeUtils;
my $VERSION = '$Revision: 1.29 $';
($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
my $clearadm = Clearadm->new;
+my %total;
+
# Given a view tag, snapshot the storage sizes
sub snapshotViewStorage($$) {
my ($tag, $region) = @_;
my ($err, $msg) = $clearadm->AddViewStorage(%viewstorage);
error $msg, $err if $err;
+
+ $total{'Views snapshotted'}++;
+
+ updateView($tag, $region);
+
+ return;
} # snapshotVobStorage
# Given a vob tag, snapshot the storage sizes
my ($err, $msg) = $clearadm->AddVobStorage(%vobstorage);
error $msg, $err, if $err;
+
+ $total{'VOBs snapshotted'}++;
+
+ updateVob($tag, $region);
+
+ return;
} # snapshotVobStorage
+sub updateVob($$) {
+ my ($tag, $region) = @_;
+
+ my ($err, $msg, $error, @output, $graph);
+
+ my %vob = $clearadm->GetVob($tag, $region);
+
+ for my $graphType (qw(admin cleartext db derivedobj source total)) {
+ #for my $graphType (qw(derivedobj)) {
+ # Windows vob tags begin with "\", which is problematic. The solution is to
+ # escape the "\"
+ my $vobtag = $tag;
+ $vobtag =~ s/^\\/\\\\/;
+
+ my $cmd = "plotstorage.cgi generate=1 type=vob storage=$graphType region=$region scaling=Day points=7 tag=$vobtag";
+
+ $graph = "${graphType}small";
+
+ verbose "Generating $graph for VOB $tag (Region: $region)";
+
+ ($error, @output) = Execute("$cmd tiny=1 2>&1");
+
+ error "Unable to generate $graph" . join("\n", @output), $error if $error;
+
+ $vob{$graph} = join '', @output;
+ $total{'VOB Graphs generated'}++;
+
+ $graph = "${graphType}large";
+
+ verbose "Generating $graph for VOB $tag (Region: $region)";
+
+ ($error, @output) = Execute("$cmd 2>&1");
+
+ error "Unable to generate $graph" . join("\n", @output), $error if $error;
+
+ $vob{$graph} = join '', @output;
+ $total{'VOB Graphs generated'}++;
+ } # for
+
+ if ($vob{tag}) {
+ ($err, $msg) = $clearadm->UpdateVob(%vob);
+
+ error "Unable to update VOB $tag (Region: $region) - $msg", $err if $err;
+
+ $total{'VOBs updated'}++;
+ } else {
+ $vob{tag} = $tag;
+ $vob{region} = $region;
+
+ ($err, $msg) = $clearadm->AddVob(%vob);
+
+ error "Unable to add VOB $tag (Region: $region) - $msg", $err if $err;
+
+ $total{'VOBs added'}++;
+ } # if
+
+ return;
+} # updateVob
+
+sub updateView($$) {
+ my ($tag, $region) = @_;
+
+ my ($err, $msg, $error, @output, $graph);
+
+ my %view = $clearadm->GetView($tag, $region);
+
+ for my $graphType (qw(private db admin total)) {
+ my $cmd = "plotstorage.cgi generate=1 type=view storage=$graphType region=$region scaling=Day points=7 tag=$tag";
+
+ $graph = "${graphType}small";
+
+ verbose "Generating $graph for View $tag (Region: $region)";
+
+ ($error, @output) = Execute("$cmd tiny=1 2>&1");
+
+ error "Unable to generate $graph" . join("\n", @output), $error if $error;
+
+ $total{'View Graphs generated'}++;
+
+ $view{$graph} = join '', @output;
+
+ $graph = "${graphType}large";
+
+ verbose "Generating $graph for View $tag (Region: $region)";
+
+ ($error, @output) = Execute("$cmd 2>&1");
+
+ error "Unable to generate $graph" . join("\n", @output), $error if $error;
+
+ $total{'View Graphs generated'}++;
+
+ $view{$graph} = join '', @output;
+ } # for
+
+ if ($view{tag}) {
+ ($err, $msg) = $clearadm->UpdateView(%view);
+
+ error "Unable to update View $tag (Region: $region) - $msg", $err if $err;
+
+ $total{'Views updated'}++;
+ } else {
+ $view{tag} = $tag;
+ $view{region} = $region;
+
+ ($err, $msg) = $clearadm->AddView(%view);
+
+ error "Unable to add VOB $tag (Region: $region) - $msg", $err if $err;
+
+ $total{'Views added'}++;
+ } # if
+
+ return;
+} # updateView
+
my %opts;
# Main
-GetOptions (
+my $startTime = time;
+
+GetOptions(
\%opts,
'usage' => sub { Usage },
'verbose' => sub { set_verbose },
} elsif ($opts{vob}) {
if ($opts{region} =~ /all/i) {
for my $region ($Clearcase::CC->regions) {
- verbose "Snapshotting view $opts{vob} in region $region";
+ verbose "Snapshotting vob $opts{vob} in region $region";
snapshotVobStorage $opts{vob}, $region;
} # for
} # if
} # if
+if (get_verbose) {
+ Stats \%total;
+ display_duration $startTime;
+} # if
+
=pod
=head1 CONFIGURATION AND ENVIRONMENT
use Net::Domain qw(hostname);
use FindBin;
use Getopt::Long;
+use Convert::Base64;
use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib";
my ($host, $fs);
# Given a host and a filesystem, formulate a fs record
-sub snapshotFS ($$) {
+sub snapshotFS($$) {
my ($systemRef, $filesystem) = @_;
my %system = %{$systemRef};
- my %filesystem = $clearadm->GetFilesystem ($system{name}, $filesystem);
+ my %filesystem = $clearadm->GetFilesystem($system{name}, $filesystem);
unless (%filesystem) {
- error "Filesystem $host:$filesystem not in clearadm database - try adding it";
-
- return;
+ error "Filesystem $host:$filesystem not in clearadm database - try adding it";
+
+ return;
} # unless
my %fs = (
if ($status != 0) {
error ('Unable to determine fsinfo for '
- . "$system{name}:$filesystem{mount} ($cmd)\n" .
- join "\n", @unixfs);
+ . "$system{name}:$filesystem{mount} ($cmd)\n"
+ . join "\n", @unixfs);
return;
} # if
} # snapshotFS
# Main
-GetOptions (
+GetOptions(
'usage' => sub { Usage },
'verbose' => sub { set_verbose },
'debug' => sub { set_debug },
'fs=s' => \$fs,
) or Usage "Invalid parameter";
-Usage 'Extraneous options: ' . join ' ', @ARGV
- if @ARGV;
+Usage 'Extraneous options: ' . join ' ', @ARGV if @ARGV;
# Announce ourselves
verbose "$FindBin::Script V$VERSION";
my $exit = 0;
for my $system ($clearadm->FindSystem ($host)) {
- next if $$system{active} eq 'false';
+ next if $system->{active} eq 'false';
- my $status = $clearexec->connectToServer (
- $$system{name},
- $$system{port}
+ my $status = $clearexec->connectToServer(
+ $system->{name},
+ $system->{port}
);
unless ($status) {
- verbose "Unable to connect to system $$system{name}:$$system{port}";
+ verbose "Unable to connect to system $system->{name}:$system->{port}";
next;
} # unless
- for my $filesystem ($clearadm->FindFilesystem ($$system{name}, $fs)) {
- verbose "Snapshotting $$system{name}:$$filesystem{filesystem}";
+ for my $filesystem ($clearadm->FindFilesystem ($system->{name}, $fs)) {
+ verbose "Snapshotting $system->{name}:$filesystem->{filesystem}";
- my %fs = snapshotFS ($system, $$filesystem{filesystem});
+ my %fs = snapshotFS($system, $filesystem->{filesystem});
if (%fs) {
- my ($err, $msg) = $clearadm->AddFS (%fs);
+ my ($err, $msg) = $clearadm->AddFS(%fs);
error $msg, $err if $err;
} # if
+ # Generate graphs
+ my $cmd = "plotfs.cgi generate=1 system=$system->{name} filesystem=$filesystem->{filesystem} scaling=Day points=7";
+
+ verbose "Generating fssmall for $system->{name}:$filesystem->{filesystem}";
+ my ($error, @output) = Execute("$cmd tiny=1 2>&1");
+
+ error 'Unable to generate fssmall' . join("\n", @output), $error if $error;
+
+ $filesystem->{fssmall} = join '', @output;
+
+ verbose "Generating fslarge for $system->{name}:$filesystem->{filesystem}";
+ ($error, @output) = Execute("$cmd 2>&1");
+
+ error 'Unable to generate fslarge' . join("\n", @output), $error if $error;
+
+ $filesystem->{fslarge} = join '', @output;
+
+ my ($err, $msg) = $clearadm->UpdateFilesystem($system->{name}, $filesystem->{filesystem}, %$filesystem);
+
+ error "Unable to update filesystem record $msg", $err if $err;
+
# Check if over threshold
- my %notification = $clearadm->GetNotification ('Filesystem');
+ my %notification = $clearadm->GetNotification('Filesystem');
- next
- unless %notification;
+ next unless %notification;
my $usedPct = '0%';
$usedPct = sprintf ('%.2f', (($fs{used} + $fs{reserve}) / $fs{size}) * 100) if $fs{size} != 0;
- if ($usedPct >= $$filesystem{threshold}) {
+ if ($usedPct >= $filesystem->{threshold}) {
$exit = 2;
display YMDHMS
- . " System: $$filesystem{system} "
- . "Filesystem: $$filesystem{filesystem} Used: $usedPct% "
- . "Threshold: $$filesystem{threshold}";
+ . " System: $filesystem->{system} "
+ . "Filesystem: $filesystem->{filesystem} Used: $usedPct% "
+ . "Threshold: $filesystem->{threshold}";
} else {
- $clearadm->ClearNotifications ($$system{name}, $$filesystem{filesystem});
+ $clearadm->ClearNotifications ($system->{name}, $filesystem->{filesystem});
} # if
} # for
my $host;
# Given a host, formulate a loadavg record
-sub snapshotLoad ($) {
+sub snapshotLoad($) {
my ($systemRef) = @_;
my %system = %{$systemRef};
my ($status, @output);
- $status = $clearexec->connectToServer (
+ $status = $clearexec->connectToServer(
$system{name}, $system{port}
);
- error "Unable to connect to system $system{name}:$system{port}", 1
- unless $status;
+ error "Unable to connect to system $system{name}:$system{port}", 1 unless $status;
verbose "Snapshotting load on $system{name}";
my $cmd = 'uptime';
- ($status, @output) = $clearexec->execute ($cmd);
+ ($status, @output) = $clearexec->execute($cmd);
- return
- if $status;
+ return if $status;
# Parsing uptime is odd. Sometimes we get output like
#
my $loadvbs = 'c:/cygwin/opt/clearscm/clearadm/load.vbs';
$cmd = "cscript /nologo $loadvbs";
- ($status, @output) = $clearexec->execute ($cmd);
+ ($status, @output) = $clearexec->execute($cmd);
chop @output if $output[0] =~ /\r/;
- return
- if $status;
+ return if $status;
$load{loadavg} = $output[0] / 100;
} # if
} # snapshotLoad
# Main
-GetOptions (
+GetOptions(
'usage' => sub { Usage },
'verbose' => sub { set_verbose },
'debug' => sub { set_debug },
'host=s' => \$host,
) or Usage "Invalid parameter";
-Usage 'Extraneous options: ' . join ' ', @ARGV
- if @ARGV;
+Usage 'Extraneous options: ' . join ' ', @ARGV if @ARGV;
# Announce ourselves
verbose "$FindBin::Script V$VERSION";
my $exit = 0;
-foreach my $system ($clearadm->FindSystem ($host)) {
- next if $$system{active} eq 'false';
+for my $system ($clearadm->FindSystem($host)) {
+ next if $system->{active} eq 'false';
my %load = snapshotLoad $system;
if (%load) {
- my ($err, $msg) = $clearadm->AddLoadavg (%load);
+ my ($err, $msg) = $clearadm->AddLoadavg(%load);
error $msg, $err if $err;
} else {
- error "Unable to get loadavg for system $$system{name}", 1;
+ error "Unable to get loadavg for system $system->{name}", 1;
} # if
# Check if over threshold
- my %notification = $clearadm->GetNotification ('Loadavg');
+ my %notification = $clearadm->GetNotification('Loadavg');
- next
- unless %notification;
+ next unless %notification;
- if ($load{loadavg} >= $$system{loadavgThreshold}) {
+ if ($load{loadavg} >= $system->{loadavgThreshold}) {
$exit = 2;
- error YMDHMS . " System: $$system{name} "
+ error YMDHMS . " System: $system->{name} "
. "Loadavg $load{loadavg} "
- . "Threshold $$system{loadavgThreshold}";
+ . "Threshold $system->{loadavgThreshold}";
} else {
- $clearadm->ClearNotifications ($$system{name});
+ $clearadm->ClearNotifications ($system->{name});
} # if
-} # foreach
+
+ # Add graphs to system record
+ my ($loadavgsmall, $loadavg);
+
+ my $cmd = "plotloadavg.cgi generate=1 system=$system->{name} scaling=Hour points=24";
+
+ verbose "Generating loadavgsmall for $system->{name}";
+ my ($error, @output) = Execute("$cmd tiny=1 2>&1");
+
+ error 'Unable to generate loadavgsmall' . join("\n", @output), $error if $error;
+
+ $system->{loadavgsmall} = join '', @output;
+
+ verbose "Generating loadavg for $system->{name}";
+ ($error, @output) = Execute("$cmd 2>&1");
+
+ error 'Unable to generate loadavg' . join("\n", @output), $error if $error;
+
+ $system->{loadavg} = join '', @output;
+
+ my ($err, $msg) = $clearadm->UpdateSystem($system->{name}, %$system);
+
+ error "Unable to udpate system record $msg", $err if $err;
+} # for
exit $exit;
? '/usr/xpg4/bin/df -l -P'
: 'df -l -TP';
- my ($status, @output) = $clearexec->execute ($cmd);
+ my ($status, @output) = $clearexec->execute($cmd);
- error "Unable to execute $cmd - $! (Status: $status)\n" . join ("\n". @output), $status
- if $status;
+ error "Unable to execute $cmd - $! (Status: $status)\n" . join ("\n". @output), $status if $status;
# Real file systems start with "/"
my @fs = grep { /^\// } @output;
return @filesystems;
} # GetFilesystems
-sub GatherSysInfo (;%) {
+sub GatherSysInfo(;%) {
my (%system) = @_;
# Set name if not currently set
- $system{name} = $host
- unless $system{name};
+ $system{name} = $host unless $system{name};
my ($status, @output);
$system{port} ||= $port;
# Connect to clearexec server
- $status = $clearexec->connectToServer ($system{name}, $system{port});
+ $status = $clearexec->connectToServer($system{name}, $system{port});
unless ($status) {
warning "Unable to connect to $system{name}:$port";
# Get OS info
my $cmd = 'uname -a';
- ($status, @output) = $clearexec->execute ($cmd);
+ ($status, @output) = $clearexec->execute($cmd);
- error "Unable to execute '$cmd' - $!", $status . join ("\n". @output)
- if $status;
+ error "Unable to execute '$cmd' - $!", $status . join("\n". @output) if $status;
$system{os} = $output[0];
$cmd = 'uname -s';
- ($status, @output) = $clearexec->execute ($cmd);
+ ($status, @output) = $clearexec->execute($cmd);
- error "Unable to execute '$cmd' - $!", $status . join ("\n". @output)
- if $status;
+ error "Unable to execute '$cmd' - $!", $status . join("\n". @output) if $status;
# TODO: Need to handle this better
if ($output[0] =~ /sunos/i) {
return %system;
} # GatherSysInfo
-sub AddFilesystems (%) {
+sub AddFilesystems(%) {
my (%system) = @_;
my ($err, $msg);
for (GetFilesystems %system) {
my %filesystem = %{$_};
- my %oldfilesystem = $clearadm->GetFilesystem (
+ my %oldfilesystem = $clearadm->GetFilesystem(
$filesystem{system},
$filesystem{filesystem}
);
if (%oldfilesystem) {
verbose "Updating filesystem $filesystem{system}:$filesystem{filesystem}";
- ($err, $msg) = $clearadm->UpdateFilesystem (
+ ($err, $msg) = $clearadm->UpdateFilesystem(
$filesystem{system},
$filesystem{filesystem},
%filesystem,
);
error 'Unable to update filesystem '
- . "$filesystem{system}:$filesystem{filesystem}"
- if $err;
+ . "$filesystem{system}:$filesystem{filesystem}" if $err;
} else {
verbose 'Adding filesystem '
. "$filesystem{system}:$filesystem{filesystem}";
- ($err, $msg) = $clearadm->AddFilesystem (%filesystem);
+ ($err, $msg) = $clearadm->AddFilesystem(%filesystem);
error 'Unable to add filesystem '
- . "$filesystem{system}:$filesystem{filesystem}"
- if $err;
- } # if
+ . "$filesystem{system}:$filesystem{filesystem}" if $err;
+ } # if
} # for
return ($err, $msg);
} # AddFilesystems
-sub AddSystem ($) {
+sub AddSystem($) {
my ($system) = @_;
verbose "Adding newhost $system";
# If GatherSysInfo was able to connect to clearagent it will set this field
my $clearagent = delete $system{clearagent};
- my ($err, $msg) = $clearadm->AddSystem (%system);
+ my ($err, $msg) = $clearadm->AddSystem(%system);
- return ($err, $msg)
- if $err;
+ return ($err, $msg) if $err;
if ($clearagent) {
return AddFilesystems %system;
} # if
} # AddSystem
-sub UpdateSystem (%) {
+sub UpdateSystem(%) {
my (%system) = @_;
my ($err, $msg);
- %system = GatherSysInfo (%system);
+ %system = GatherSysInfo(%system);
# If GatherSysInfo was able to connect to clearagent it will set this field
my $clearagent = delete $system{clearagent};
verbose "Updating existing host $system{name}";
- ($err, $msg) = $clearadm->UpdateSystem ($system{name}, %system);
+ ($err, $msg) = $clearadm->UpdateSystem($system{name}, %system);
return ($err, $msg) if $err;
$host = hostname;
$port = $Clearexec::CLEAROPTS{CLEAREXEC_PORT};
-GetOptions (
+GetOptions(
'usage' => sub { Usage },
'verbose' => sub { set_verbose },
'debug' => sub { set_debug },
'port=s' => \$port,
) or Usage "Invalid parameter";
-Usage 'Extraneous options: ' . join ' ', @ARGV
- if @ARGV;
+Usage 'Extraneous options: ' . join ' ', @ARGV if @ARGV;
if ($delete) {
- error "Must specify -host if you specify -delete", 1
- unless $host;
+ error "Must specify -host if you specify -delete", 1 unless $host;
} # if
# Announce ourselves
my $answer = <STDIN>;
if ($answer =~ /(y|yes)/i) {
- ($err, $msg) = $clearadm->DeleteSystem ($host);
+ ($err, $msg) = $clearadm->DeleteSystem($host);
if ($err == 0) {
error "No host named $host in database";
for ($clearadm->FindSystem) {
my %system = %$_;
- ($err, $msg) = UpdateSystem (%system);
+ ($err, $msg) = UpdateSystem(%system);
- error "Unable to update host $system{name}\n$msg", $err
- if $err;
+ error "Unable to update host $system{name}\n$msg", $err if $err;
} # for
} else {
- my %system = $clearadm->GetSystem ($host);
+ my %system = $clearadm->GetSystem($host);
if (%system) {
- ($err, $msg) = UpdateSystem (%system);
+ ($err, $msg) = UpdateSystem(%system);
} else {
- ($err, $msg) = AddSystem ($host);
+ ($err, $msg) = AddSystem($host);
} # if
if ($err) {
use FindBin;
use Getopt::Long;
-use CGI qw (:standard :cgi-lib *table start_Tr end_Tr);
+use CGI qw(:standard :cgi-lib *table start_Tr end_Tr);
use CGI::Carp 'fatalsToBrowser';
use File::stat;
use Time::localtime;
my %total;
my $nbrThreshold; # Number of views threshold - think top 10
-sub GenerateRegion ($) {
+sub GenerateRegion($) {
my ($region) = @_;
verbose "Processing region $region";
verbose_nolf '.';
}# if
- my $view = Clearcase::View->new ($name, $region);
+ my $view = Clearcase::View->new($name, $region);
my $gpath;
# Note if the view server is unreachable (e.g. user puts view on laptop and
# the laptop is powered off), then these fields will be undef. Change them
# to Unknown. (Should Clearcase::View.pm do this instead?).
- my $type = $view->type;
- $type ||= 'Unknown';
+ my $type = $view->type;
+ $type ||= 'dynamic';
+ my $ownerid = $view->owner;
+ $ownerid ||= 'Unknown';
my $user;
- my $ownerid = $view->owner;
-
if ($ownerid =~ /^\w+(\\|\/)(\w+)/) {
# TODO: Handle user identification better
#$user = User->new ($ownerid);
# Compute age
$age = Age ($modified_date);
$ageSuffix = $age != 1 ? 'days' : 'day';
- #} else {
- # $modified_date = 'Unknown';
} # if
my %oldView = $clearadm->GetView($view->tag, $view->region);
my ($err, $msg);
my %viewRec = (
- system => $view->shost,
region => $view->region,
tag => $view->tag,
owner => $ownerid,
$viewRec{modified} = $modified_date if $modified_date;
if (%oldView) {
- ($err, $msg) = $clearadm->UpdateView($view->tag, $view->region, %viewRec);
+ ($err, $msg) = $clearadm->UpdateView(%viewRec);
error "Unable to update view $name in Clearadm\n$msg", $err if $err;
} else {
- ($err, $msg) = $clearadm->AddView (%viewRec);
+ ($err, $msg) = $clearadm->AddView(%viewRec);
error "Unable to add view $name to Clearadm\n$msg", $err if $err;
} # if
sub Generate ($) {
my ($region) = @_;
- if ($region =~ /all/i) {
- for ($Clearcase::CC->regions) {
- GenerateRegion $_;
- } # for
- } else {
+ if ($region) {
GenerateRegion $region;
+ } else {
+ GenerateRegion $_ for $Clearcase::CC->regions;
} # if
return;
return;
} # Report
-sub FormatTable ($@) {
+sub FormatTable($@) {
my ($style, @views) = @_;
my $table;
my $caption;
- my $regionDropdown = start_form (
+ my $regionDropdown = start_form(
-action => $script,
);
$regionDropdown .= font {-class => 'captionLabel'}, 'Region: ';
- $regionDropdown .= popup_menu (
+ $regionDropdown .= popup_menu(
-name => 'region',
-values => [$Clearcase::CC->regions],
-default => $Clearcase::CC->region,
# TODO: Add an option to remove views older than a certain date
-sub EmailUser ($@) {
+sub EmailUser($@) {
my ($emailTo, @oldViews) = @_;
@oldViews = sort { $$b{age} <=> $$a{age} } @oldViews;
- my $msg = '<style>' . join ("\n", ReadFile 'viewager.css') . '</style>';
+ my $msg = '<style>' . join("\n", ReadFile 'viewager.css') . '</style>';
$msg .= <<"END";
<h1 align="center">You have old Clearcase Views</h1>
Your friendly Clearcase Administrator
END
- mail (
+ mail(
to => $emailTo,
# to => 'Andrew@DeFaria.com',
mode => 'html',
return
} # EmailUser
-sub EmailUsers (@) {
+sub EmailUsers(@) {
my (@views) = @_;
@views = sort { $$a{ownerName} cmp $$b{ownerName} } @views;
for (@views) {
my %view = %{$_};
- next
- unless $view{email};
+ next unless $view{email};
if ($currUser ne $view{ownerName}) {
- EmailUser $view{email}, @userViews
- if @userViews;
+ EmailUser $view{email}, @userViews if @userViews;
$currUser = $view{ownerName};
- @userViews =();
+ @userViews = ();
} else {
if ($view{age} > $opts{ageThreshold}) {
push @userViews, \%view
} # EmailUsers
# Main
-GetOptions (
+GetOptions(
\%opts,
'usage' => sub { Usage },
'verbose' => sub { set_verbose },
$clearadm = Clearadm->new;
if ($opts{action} and $opts{action} eq 'generate') {
- $opts{region} ||= 'all';
-
Generate $opts{region};
Stats \%total if $opts{verbose};
} else {
$opts{region} ||= $Clearcase::CC->region;
- my @views = $clearadm->FindView (
- 'all',
- $opts{region},
+ my @views = $clearadm->FindView(
$opts{tag},
+ $opts{region},
$opts{user}
);
use FindBin;
use Getopt::Long;
-use CGI qw (:standard :cgi-lib *table start_Tr end_Tr);
+use CGI qw(:standard :cgi-lib *table start_Tr end_Tr);
use CGI::Carp 'fatalsToBrowser';
use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib";
+use Clearadm;
use ClearadmWeb;
use Clearcase;
use Clearcase::View;
my $subtitle = 'View Details';
-if ($Clearcase::CC->region) {
- $opts{region} ||= $Clearcase::CC->region;
-} else {
- $opts{region} ||= 'Clearcase not installed';
-} # if
+$opts{region} ||= $Clearcase::CC->region;
-my $VERSION = '$Revision: 1.11 $';
+my $VERSION = '$Revision: 1.12 $';
($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
sub DisplayTable ($) {
-class => 'main',
};
+ my $clearadm = Clearadm->new;
+
+ my %clearadmview = $clearadm->GetView($view->tag, $view->region);
+
display start_Tr;
display th {class => 'label'}, 'Tag:';
display td {class => 'data', colspan => 3}, setField $view->tag;
display th {class => 'labelCentered', colspan => 10}, 'View Storage Pools';
display end_Tr;
+ my $image = $clearadmview{dbsmall}
+ ? "data:image/png;base64,$clearadmview{dbsmall}"
+ : "plotstorage.cgi?type=view&storage=db&tiny=1&tag=" . $view->tag;
+
display start_Tr;
display th {class => 'label'}, 'Database:';
display td {class => 'data', colspan => 3, align => 'center'}, a {href =>
- "plot.cgi?type=view&storage=private&tag=" . $view->tag
+ "plot.cgi?type=view&storage=db&scaling=Day&points=7®ion=" . $view->region . '&tag=' . $view->tag
}, img {
- src => "plotstorage.cgi?type=view&storage=private&tiny=1&tag=" . $view->tag,
+ src => $image,
border => 0,
};
+
+ $image = $clearadmview{privatesmall}
+ ? "data:image/png;base64,$clearadmview{privatesmall}"
+ : "plotstorage.cgi?type=view&storage=private&tiny=1&tag=" . $view->tag;
+
display th {class => 'label'}, 'Private:';
display td {class => 'data', colspan => 5, align => 'center'}, a {href =>
- "plot.cgi?type=view&storage=db&tag=" . $view->tag
+ "plot.cgi?type=view&storage=private&scaling=Day&points=7®ion=" . $view->region . '&tag=' . $view->tag
}, img {
- src => "plotstorage.cgi?type=view&storage=db&tiny=1&tag=" . $view->tag,
+ src => $image,
border => 0,
};
display end_Tr;
+ $image = $clearadmview{adminsmall}
+ ? "data:image/png;base64,$clearadmview{adminsmall}"
+ : "plotstorage.cgi?type=view&storage=admin&tiny=1&tag=" . $view->tag;
+
display start_Tr;
display th {class => 'label'}, 'Admin:';
display td {class => 'data', colspan => 3, align => 'center'}, a {href =>
- "plot.cgi?type=view&storage=admin&tag=" . $view->tag
+ "plot.cgi?type=view&storage=admin&scaling=Day&points=7®ion=" . $view->region . '&tag=' . $view->tag
}, img {
- src => "plotstorage.cgi?type=view&storage=admin&tiny=1&tag=" . $view->tag,
+ src => $image,
border => 0,
};
+
+ $image = $clearadmview{totalsmall}
+ ? "data:image/png;base64,$clearadmview{totalsmall}"
+ : "plotstorage.cgi?type=view&storage=total&tiny=1&tag=" . $view->tag;
+
display th {class => 'label'}, 'Total Space:';
display td {class => 'data', colspan => 5, align => 'center'}, a {href =>
- "plot.cgi?type=view&storage=total&tag=" . $view->tag
+ "plot.cgi?type=view&storage=total&scaling=Day&points=7®ion=" . $view->region . '&tag=' . $view->tag
}, img {
- src => "plotstorage.cgi?type=view&storage=total&tiny=1&tag=" . $view->tag,
+ src => $image,
border => 0,
};
display end_Tr;
return
} # DisplayTable
-sub DisplayRegion {
+sub DisplayRegion() {
display start_form (action => 'viewdetails.cgi');
display 'Region ';
- my ($defaultRegion, @regions) = ('', ('Clearcase not installed'));
-
display popup_menu (
-name => 'region',
- -values => [@regions],
- -default => $defaultRegion,
+ -values => [$Clearcase::CC->regions],
+ -default => $Clearcase::CC->region,
-onchange => 'submit();',
);
return
} # DisplayRegion
-sub DisplayViews ($) {
+sub DisplayViews($) {
my ($region) = @_;
my $views = Clearcase::Views->new ($region);
push @views, 'No Views';
} # unless
- display start_form (action => 'viewdetails.cgi');
+ display start_form(action => 'viewdetails.cgi');
display 'Region ';
-onchange => 'submit();',
);
- display submit (
+ display submit(
-value => 'Go',
);
} # DisplayViews
# Main
-GetOptions (
+GetOptions(
\%opts,
'usage' => sub { Usage },
'verbose' => sub { set_verbose },
exit;
} # unless
-my $view = Clearcase::View->new ($opts{tag}, $opts{region});
-
-DisplayTable $view;
+DisplayTable(Clearcase::View->new($opts{tag}, $opts{region}));
footing;
=begin man
+ Clearadm
ClearadmWeb
Clearcase
Clearcase::View
=begin html
<blockquote>
+<a href="http://clearscm.com/php/scm_man.php?file=clearadm/lib/Clearadm.pm">Clearadm</a><br>
<a href="http://clearscm.com/php/scm_man.php?file=clearadm/lib/ClearadmWeb.pm">ClearadmWeb</a><br>
<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase.pm">Clearcase</a><br>
<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/View.pm">Clearcase::View</a><br>
use FindBin;
use Getopt::Long;
-use CGI qw (:standard :cgi-lib *table start_Tr end_Tr);
+use CGI qw(:standard :cgi-lib *table start_Tr end_Tr);
use CGI::Carp 'fatalsToBrowser';
use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib";
my $VERSION = '$Revision: 1.9 $';
($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
-sub DisplayTable (@) {
+sub DisplayTable(@) {
my (@viewServers) = @_;
my $unknown = font {-class => 'unknown'}, 'Unknown';
my $i = 0;
- foreach (@viewServers) {
+ for (@viewServers) {
my $server = Clearcase::Server->new ($_, $opts{region});
# Data fields
-class => 'data',
}, $osVer;
display end_Tr;
- } # foreach
+ } # for
display end_table;
} # DisplayTable
# Main
-GetOptions (
+GetOptions(
\%opts,
'usage' => sub { Usage },
'verbose' => sub { set_verbose },
my %viewServers;
-foreach (@output) {
+for (@output) {
if (/Server host: (.*)/) {
$viewServers{$1} = undef;
} # if
-} # foreach
+} # for
-DisplayTable sort (keys (%viewServers));
+DisplayTable sort(keys(%viewServers));
footing;
use FindBin;
use Getopt::Long;
-use CGI qw (:standard :cgi-lib *table start_Tr end_Tr);
+use CGI qw(:standard :cgi-lib *table start_Tr end_Tr);
use CGI::Carp 'fatalsToBrowser';
use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib";
+use Clearadm;
use ClearadmWeb;
use Clearcase;
use Clearcase::Vob;
my $VERSION = '$Revision: 1.11 $';
($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
-sub DisplayTable ($) {
+sub DisplayTable($) {
my ($vob) = @_;
my $active = ($vob->active) ? 'YES' : 'NO';
-class => 'main',
};
+ my $clearadm = Clearadm->new;
+
+ my %clearadmvob = $clearadm->GetVob($vob->tag, $vob->region);
+
display start_Tr;
display th {class => 'label'}, 'Tag:';
display td {class => 'data', colspan => 3}, setField $vob->tag;
display th {class => 'labelCentered', colspan => 10}, 'VOB Storage Pools';
display end_Tr;
+ my $image = $clearadmvob{adminsmall}
+ ? "data:image/png;base64,$clearadmvob{adminsmall}"
+ : "plotstorage.cgi?type=vob&storage=admin&tiny=1&tag=" . $vob->tag;
+
display start_Tr;
display th {class => 'label'}, 'Admin:';
display td {class => 'data', colspan => 4, align => 'center'}, a {href =>
- "plot.cgi?type=vob&storage=admin&scaling=Hour&points=24&tag=" . $vob->tag
+ 'plot.cgi?type=vob&storage=admin&scaling=Day&points=7®ion=' . $vob->region . '&tag=' . $vob->tag
}, img {
- src => "plotstorage.cgi?type=vob&storage=admin&tiny=1&tag=" . $vob->tag,
+ src => $image,
border => 0,
};
+
+ $image = $clearadmvob{sourcesmall}
+ ? "data:image/png;base64,$clearadmvob{sourcesmall}"
+ : 'plotstorage.cgi?type=vob&storage=source&tiny=1®ion=' . $vob->region . '&tag=' . $vob->tag;
+
display th {class => 'label'}, 'Source Size:';
display td {class => 'data', colspan => 4, align => 'center'}, a {href =>
- "plot.cgi?type=vob&storage=source&scaling=Hour&points=24&tag=" . $vob->tag
+ 'plot.cgi?type=vob&storage=source&scaling=Day&points=7®ion=' . $vob->region . '&tag=' . $vob->tag
}, img {
- src => "plotstorage.cgi?type=vob&storage=source&tiny=1&tag=" . $vob->tag,
+ src => $image,
border => 0,
};
display end_Tr;
display start_Tr;
+ $image = $clearadmvob{dbsmall}
+ ? "data:image/png;base64,$clearadmvob{dbsmall}"
+ : 'plotstorage.cgi?type=vob&storage=db&tiny=1®ion=' . $vob->region . '&tag=' . $vob->tag;
+
display th {class => 'label'}, 'Database:';
display td {class => 'data', colspan => 4, align => 'center'}, a {href =>
- "plot.cgi?type=vob&storage=db&scaling=Hour&points=24&tag=" . $vob->tag
+ 'plot.cgi?type=vob&storage=db&scaling=Day&points=7®ion=' . $vob->region . '&tag=' . $vob->tag
}, img {
- src => "plotstorage.cgi?type=vob&storage=db&tiny=1&tag=" . $vob->tag,
+ src => $image,
border => 0,
};
+
+ $image = $clearadmvob{derivedobjsmall}
+ ? "data:image/png;base64,$clearadmvob{derivedobjsmall}"
+ : 'plotstorage.cgi?type=vob&storage=derivedobj&tiny=1®ion=' . $vob->region . '&tag=' . $vob->tag;
+
display th {class => 'label'}, 'Derived Obj:';
display td {class => 'data', colspan => 4, align => 'center'}, a {href =>
- "plot.cgi?type=vob&storage=derivedobj&scaling=Hour&points=24&tag=" . $vob->tag
+ 'plot.cgi?type=vob&storage=derivedobj&scaling=Day&points=7®ion=' . $vob->region . '&tag=' . $vob->tag
}, img {
- src => "plotstorage.cgi?type=vob&storage=derivedobj&tiny=1&tag=" . $vob->tag,
+ src => $image,
border => 0,
};
display end_Tr;
display start_Tr;
+ $image = $clearadmvob{cleartextsmall}
+ ? "data:image/png;base64,$clearadmvob{cleartextsmall}"
+ : 'plotstorage.cgi?type=vob&storage=cleartext&tiny=1®ion=' . $vob->retion . '&tag=' . $vob->tag;
+
display th {class => 'label'}, 'Cleartext:';
display td {class => 'data', colspan => 4, align => 'center'}, a {href =>
- "plot.cgi?type=vob&storage=cleartext&scaling=Hour&points=24&tag=" . $vob->tag
+ 'plot.cgi?type=vob&storage=cleartext&scaling=Day&points=7®ion=' . $vob->region . '&tag=' . $vob->tag
}, img {
- src => "plotstorage.cgi?type=vob&storage=cleartext&tiny=1&tag=" . $vob->tag,
+ src => $image,
border => 0,
};
+
+ $image = $clearadmvob{totalsmall}
+ ? "data:image/png;base64,$clearadmvob{totalsmall}"
+ : 'plotstorage.cgi?type=vob&storage=total&tiny=1®ion=' . $vob->region . '&tag=' . $vob->tag;
+
display th {class => 'label'}, 'Total Size:';
display td {class => 'data', colspan => 4, align => 'center'}, a {href =>
- "plot.cgi?type=vob&storage=total&scaling=Hour&points=24&tag=" . $vob->tag
+ 'plot.cgi?type=vob&storage=total&scaling=Day&points=7®ion=' . $vob->region . '&tag=' . $vob->tag
}, img {
- src => "plotstorage.cgi?type=vob&storage=total&tiny=1&tag=" . $vob->tag,
+ src => $image,
border => 0,
};
display end_Tr;
return;
} # DisplayTable
-sub DisplayRegion {
+sub DisplayRegion() {
display start_form (action => 'vobdetails.cgi');
display 'Region ';
my ($defaultRegion, @regions) = ('', ('Clearcase not installed'));
- display popup_menu (
+ display popup_menu(
-name => 'region',
-values => [@regions],
-default => $defaultRegion,
-onchange => 'submit();',
);
- display submit (
+ display submit(
-value => 'Go',
);
push @vobs, 'No VOBs';
} # unless
- display start_form (action => 'vobdetails.cgi');
+ display start_form(action => 'vobdetails.cgi');
display 'Region ';
- display popup_menu (
+ display popup_menu(
-name => 'region',
-values => [$Clearcase::CC->regions],
-default => $region,
display b ' VOB: ';
- display popup_menu (
+ display popup_menu(
-name => 'vob',
-values => \@vobs,
-onchange => 'submit();',
);
- display submit (
+ display submit(
-value => 'Go',
);
} # DisplayVobs
# Main
-GetOptions (
+GetOptions(
\%opts,
'usage' => sub { Usage },
'verbose' => sub { set_verbose },
exit;
} # unless
-my $vob = Clearcase::Vob->new ($opts{tag}, $opts{region});
+my $vob = Clearcase::Vob->new($opts{tag}, $opts{region});
DisplayTable $vob;
=begin html
<blockquote>
+<a href="http://clearscm.com/php/scm_man.php?file=clearadm/lib/Clearadm.pm">Clearadm</a><br>
<a href="http://clearscm.com/php/scm_man.php?file=clearadm/lib/ClearadmWeb.pm">ClearadmWeb</a><br>
<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase.pm">Clearcase</a><br>
<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/View.pm">Clearcase::View</a><br>
use FindBin;
use Getopt::Long;
-use CGI qw (:standard :cgi-lib *table start_Tr end_Tr start_ol end_ol);
+use CGI qw(:standard :cgi-lib *table start_Tr end_Tr start_ol end_ol);
use CGI::Carp 'fatalsToBrowser';
use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib";
display end_table;
} # DisplayVob
-sub DisplayTable (@) {
+sub DisplayTable(@) {
my (@vobServers) = @_;
my $unknown = font {-class => 'unknown'}, 'Unknown';
my $server;
for (@vobServers) {
- $server = Clearcase::Server->new ($_, $opts{region});
+ $server = Clearcase::Server->new($_, $opts{region});
display start_Tr;
display td {
} # DisplayTable
# Main
-GetOptions (
+GetOptions(
\%opts,
'usage' => sub { Usage },
'verbose' => sub { set_verbose },
);
error "Unable to list all vobs in the region $opts{region}"
- . join ("\n", @output), 1
- if $status;
+ . join("\n", @output), 1 if $status;
my %vobServers;
} # if
} # for
-DisplayTable sort (keys (%vobServers));
+DisplayTable sort(keys(%vobServers));
footing;
use Clearcase;
use Display;
-sub new ($;$) {
+sub new($;$) {
my ($class, $tag, $region) = @_;
=pod
=cut
- my $self = bless { tag => $tag }, $class;
+ $region ||= $Clearcase::CC->region;
+
+ my $self = bless {
+ tag => $tag,
+ region => $region
+ }, $class;
- $self->updateViewInfo ($region);
+ $self->updateViewInfo;
return $self;
} # new
-sub accessed_by () {
+sub accessed_by() {
my ($self) = @_;
=pod
return $self->{accessed_by};
} # accessed_by
-sub accessed_date () {
+sub accessed_date() {
my ($self) = @_;
=pod
return $self->{accessed_date};
} # accessed_date
-sub access_path () {
+sub access_path() {
my ($self) = @_;
=pod
return $self->{access_path};
} # access_path
-sub active () {
+sub active() {
my ($self) = @_;
=pod
return $self->{active};
} # active
-sub additional_groups () {
+sub additional_groups() {
my ($self) = @_;
=pod
} # if
} # additional_groups
-sub created_by () {
+sub created_by() {
my ($self) = @_;
=pod
return $self->{created_by};
} # created_by
-sub created_date () {
+sub created_date() {
my ($self) = @_;
=pod
return $self->{created_date};
} # created_date
-sub cs_updated_by () {
+sub cs_updated_by() {
my ($self) = @_;
=pod
return $self->{cs_updated_by};
} # cs_updated_by
-sub cs_updated_date () {
+sub cs_updated_date() {
my ($self) = @_;
=pod
return $self->{cs_updated_date};
} # cs_updated_date
-sub dynamic () {
+sub dynamic() {
my ($self) = @_;
=pod
=cut
+ return unless $self->{type};
return $self->type eq 'dynamic';
} # dynamic
-sub gpath () {
+sub gpath() {
my ($self) = @_;
=pod
return $self->{gpath};
} # gpath
-sub group () {
+sub group() {
my ($self) = @_;
=pod
return $self->{group};
} # group
-sub group_mode () {
+sub group_mode() {
my ($self) = @_;
=pod
return $self->{group_mode};
} # group_mode
-sub host () {
+sub host() {
my ($self) = @_;
=pod
return $self->{host};
} # host
-sub mode () {
+sub mode() {
my ($self) = @_;
=pod
return $self->{mode};
} # mode
-sub modified_by () {
+sub modified_by() {
my ($self) = @_;
=pod
return $self->{modified_by};
} # modified_by
-sub modified_date () {
+sub modified_date() {
my ($self) = @_;
=pod
return $self->{modified_date};
} # modified_date
-sub other_mode () {
+sub other_mode() {
my ($self) = @_;
=pod
return $self->{other_mode};
} # other_mode
-sub owner () {
+sub owner() {
my ($self) = @_;
=pod
return $self->{owner}
} # owner
-sub owner_mode () {
+sub owner_mode() {
my ($self) = @_;
=pod
return $self->{owner_mode}
} # owner_mode
-sub properties () {
+sub properties() {
my ($self) = @_;
=pod
return $self->{properties};
} # properties
-sub region () {
+sub region() {
my ($self) = @_;
=pod
return $self->{region};
} # region
-sub shost () {
+sub shost() {
my ($self) = @_;
=pod
return $self->{shost};
} # shost
-sub snapshot () {
+sub snapshot() {
my ($self) = @_;
=pod
=cut
+ return unless $self->{type};
return $self->type eq 'snapshot';
} # snapshot
-sub webview () {
+sub webview() {
my ($self) = @_;
=pod
=cut
- return $self->type eq 'webview';
+ return unless $self->{type};
+ return $self->{type} eq 'webview';
} # webview
-sub tag () {
+sub tag() {
my ($self) = @_;
=pod
return $self->{tag};
} # tag
-sub text_mode () {
+sub text_mode() {
my ($self) = @_;
=pod
return $self->{text_mode};
} # tag
-sub type () {
+sub type() {
my ($self) = @_;
=pod
=cut
- return $self->{type} ? $self->{type} : 'Unknown';
+ return $self->{type};
} # type
-sub ucm () {
+sub ucm() {
my ($self) = @_;
=pod
return $self->{ucm};
} # ucm
-sub uuid () {
+sub uuid() {
my ($self) = @_;
=pod
return $self->{uuid};
} # uuid
-sub exists () {
+sub exists() {
my ($self) = @_;
=pod
=cut
- my ($status, @output) = $Clearcase::CC->execute ("lsview $self->{tag}");
+ my ($status, @output) = $Clearcase::CC->execute("lsview -region $self->{region} $self->{tag}");
return !$status;
} # exists
-sub create (;$$$) {
+sub create(;$$$) {
my ($self, $host, $vws, $region) = @_;
=pod
$region ||= $Clearcase::CC->region;
if ($self->exists) {
- $self->updateViewInfo ($region);
+ $self->updateViewInfo;
return (0, ())
} # if
if ($host && $vws) {
($status, @output) =
- $Clearcase::CC->execute ("mkview -tag $self->{tag} -region $region "
+ $Clearcase::CC->execute("mkview -tag $self->{tag} -region $region "
. "-host $host -hpath $vws -gpath $vws $vws");
} else {
# Note this requires that -stgloc's work and that using -auto is not a
# problem.
($status, @output) =
- $Clearcase::CC->execute ("mkview -tag $self->{tag} -stgloc -auto");
+ $Clearcase::CC->execute("mkview -tag $self->{tag} -stgloc -auto");
} # if
- $self->updateViewInfo ($region);
+ $self->updateViewInfo;
return ($status, @output);
} # create
-sub createUCM ($$) {
+sub createUCM($$) {
my ($self, $stream, $pvob, $region) = @_;
=pod
# Need to create the view
my ($status, @output) =
- $Clearcase::CC->execute ("mkview -tag $self->{tag} -stream "
+ $Clearcase::CC->execute("mkview -tag $self->{tag} -stream "
. "$self->{stream}\@$self->{pvob} -stgloc -auto");
return ($status, @output)
if $status;
- $self->updateViewInfo ($region);
+ $self->updateViewInfo;
return ($status, @output);
} # createUCM
-sub remove () {
+sub remove() {
my ($self) = @_;
=pod
my ($status, @output);
if ($self->dynamic) {
- ($status, @output) = $Clearcase::CC->execute (
+ ($status, @output) = $Clearcase::CC->execute(
"rmview -force -tag $self->{tag}"
);
} else {
error 'Removal of snapshot views not implemented yet', 1;
- #($status, @output) = $Clearcase::CC->execute (
+ #($status, @output) = $Clearcase::CC->execute(
# "rmview -force $self->{snapshot_view_pname}"
#);
} # if
return ($status, @output);
} # remove
-sub start () {
+sub start() {
my ($self) = @_;
=pod
=cut
- return $Clearcase::CC->execute ("startview $self->{tag}");
+ return $Clearcase::CC->execute("startview $self->{tag}");
} # start
-sub stop () {
+sub stop() {
my ($self) = @_;
=pod
=cut
- return $Clearcase::CC->execute ("endview $self->{tag}");
+ return $Clearcase::CC->execute("endview $self->{tag}");
} # stop
-sub kill () {
+sub kill() {
my ($self) = @_;
=pod
=cut
- return $Clearcase::CC->execute ("endview -server $self->{tag}");
+ return $Clearcase::CC->execute("endview -server $self->{tag}");
} # kill
-sub set () {
+sub set() {
my ($self) = @_;
=pod
return ($status, @output);
} # set
-sub updateViewInfo ($$) {
- my ($self, $region) = @_;
-
- $region ||= $Clearcase::CC->region;
+sub updateViewInfo($$) {
+ my ($self) = @_;
- my ($status, @output) = $Clearcase::CC->execute (
- "lsview -region $region -long -properties -full $self->{tag}"
+ my ($status, @output) = $Clearcase::CC->execute(
+ "lsview -region $self->{region} -long -properties -full $self->{tag}"
);
+ return if $status;
+
# Assuming this view is an empty shell of an object that the user may possibly
# use the create method on, return our blessings...
sub updateViewSpace() {
my ($self) = @_;
- my ($status, @output) = $Clearcase::CC->execute (
+ my ($status, @output) = $Clearcase::CC->execute(
"space -region $self->{region} -view $self->{tag}"
);
use Clearcase;
use OSDep;
-sub new ($) {
- my ($class, $tag) = @_;
+sub new($;$) {
+ my ($class, $tag, $region) = @_;
=pod
=cut
+ $region ||= $Clearcase::CC->region;
+
$class = bless {
- tag => $tag
+ tag => $tag,
+ region => $region,
}, $class;
$class->updateVobInfo;
return $class;
} # new
-sub tag () {
+sub tag() {
my ($self) = @_;
=pod
return $self->{tag};
} # tag
-sub gpath () {
+sub gpath() {
my ($self) = @_;
=pod
return $self->{gpath};
} # gpath
-sub shost () {
+sub shost() {
my ($self) = @_;
=pod
sub name() {
goto &tag;
} # name
-sub access () {
+
+sub access() {
my ($self) = @_;
=pod
return $self->{access};
} # access
-sub mopts () {
+sub mopts() {
my ($self) = @_;
=pod
return $self->{mopts};
} # mopts
-sub region () {
+sub region() {
my ($self) = @_;
=pod
return $self->{region};
} # region
-sub active () {
+sub active() {
my ($self) = @_;
=pod
return $self->{active};
} # active
-sub replica_uuid () {
+sub replica_uuid() {
my ($self) = @_;
=pod
return $self->{replica_uuid};
} # replica_uuid
-sub host () {
+sub host() {
my ($self) = @_;
=pod
return $self->{host};
} # host
-sub access_path () {
+sub access_path() {
my ($self) = @_;
=pod
return $self->{access_path};
} # access_path
-sub family_uuid () {
+sub family_uuid() {
my ($self) = @_;
=pod
return $self->{family_uuid};
} # family_uuid
-sub vob_registry_attributes () {
+sub vob_registry_attributes() {
my ($self) = @_;
=pod
return $self->{vob_registry_attributes};
} # vob_registry_attributes
-sub expand_space () {
+sub expand_space() {
my ($self) = @_;
my ($status, @output) = $Clearcase::CC->execute ("space -vob $self->{tag}");
return;
} # expand_space
-sub expand_description () {
+sub expand_description() {
my ($self) = @_;
- my ($status, @output) = $Clearcase::CC->execute ("describe -long vob:$self->{tag}");
+ my ($status, @output) = $Clearcase::CC->execute("describe -long vob:$self->{tag}");
for (my $i = 0; $i < @output; $i++) {
if ($output[$i] =~ /created (\S+) by (.+) \((\S+)\)/) {
return %{$self->{hyperlinks}};
} # hyperlinks
-sub countdb () {
+sub countdb() {
my ($self) = @_;
# Set values to zero in case we cannot get the right values from countdb
chomp $cwd;
chdir "$self->{gpath}/db";
- my $cmd = "$Clearcase::COUNTDB vob_db 2>&1";
- my @output = `$cmd`;
+ my $cmd = "$Clearcase::COUNTDB vob_db 2>&1";
+ my @output = `$cmd`;
- if ($? != 0) {
- chdir $cwd;
- return;
- } # if
+ if ($? != 0) {
+ chdir $cwd;
+ return;
+ } # if
chomp @output;
return;
} # countdb
-sub elements () {
+sub elements() {
my ($self) = @_;
=pod
return $self->{elements};
} # elements
-sub branches () {
+sub branches() {
my ($self) = @_;
=pod
return $self->{branches};
} # branches
-sub versions () {
+sub versions() {
my ($self) = @_;
=pod
return $self->{versions};
} # versions
-sub dbsize () {
+sub dbsize() {
my ($self) = @_;
=pod
return $self->{dbsize};
} # dbsize
-sub admsize () {
+sub admsize() {
my ($self) = @_;
=pod
return $self->{admsize};
} # admsize
-sub ctsize () {
+sub ctsize() {
my ($self) = @_;
=pod
return $self->{ctsize};
} # ctsize
-sub dosize () {
+sub dosize() {
my ($self) = @_;
=pod
return $self->{dosize};
} # dosize
-sub srcsize () {
+sub srcsize() {
my ($self) = @_;
=pod
return $self->{srcsize};
} # srcsize
-sub size () {
+sub size() {
my ($self) = @_;
=pod
return $self->{size};
} # size
-sub mount () {
+sub mount() {
my ($self) = @_;
=pod
return 0 if $self->{active} && $self->{active} eq "YES";
- my ($status, @output) = $Clearcase::CC->execute ("mount $self->{tag}");
+ my ($status, @output) = $Clearcase::CC->execute("mount $self->{tag}");
return ($status, @output);
} # mount
-sub umount () {
+sub umount() {
my ($self) = @_;
=pod
=cut
- my ($status, @output) = $Clearcase::CC->execute ("umount $self->{tag}");
+ my ($status, @output) = $Clearcase::CC->execute("umount $self->{tag}");
return ($status, @output);
} # umount
-sub exists () {
+sub exists() {
my ($self) = @_;
=pod
=cut
- my ($status, @output) = $Clearcase::CC->execute ("lsvob $self->{tag}");
+ my ($status, @output) = $Clearcase::CC->execute("lsvob -region $self->{region} $self->{tag}");
return !$status;
} # exists
-sub create (;$$$%) {
+sub create(;$$$%) {
my ($self, $host, $vbs, $comment, %opts) = @_;
=pod
if ($host && $vbs) {
$additionalOpts .= '-ucmproject' if $self->{ucmproject};
- ($status, @output) = $Clearcase::CC->execute (
+ ($status, @output) = $Clearcase::CC->execute(
"mkvob -tag $self->{tag} $comment $additionalOpts -host $host -hpath $vbs "
. "-gpath $vbs $vbs");
} else {
# Note this requires that -stgloc's work and that using -auto is not a
# problem.
($status, @output) =
- $Clearcase::CC->execute ("mkvob -tag $self->{tag} $comment $additionalOpts -stgloc -auto");
+ $Clearcase::CC->execute("mkvob -tag $self->{tag} $comment $additionalOpts -stgloc -auto");
} # if
$self->updateVobInfo;
return ($status, @output);
} # create
-sub remove () {
+sub remove() {
my ($self) = @_;
=pod
=cut
- return $Clearcase::CC->execute ("rmvob -force $self->{gpath}");
+ return $Clearcase::CC->execute("rmvob -force $self->{gpath}");
} # remove
sub updateVobInfo ($$) {
my ($self) = @_;
- my ($status, @output) = $Clearcase::CC->execute ("lsvob -long $self->{tag}");
+ my ($status, @output) = $Clearcase::CC->execute("lsvob -long $self->{tag}");
# Assuming this vob is an empty shell of an object that the user may possibly
# use the create method on, return our blessings...
my $SECS_IN_DAY = $SECS_IN_HOUR * 24;
# Forwards
-sub Today2SQLDatetime();
-sub DateToEpoch($);
-sub EpochToDate($);
+sub Today2SQLDatetime ();
+sub DateToEpoch ($);
+sub EpochToDate ($);
-sub ymdhms(;$) {
+sub ymdhms {
my ($time) = @_;
$time ||= time;
$wday,
$yday,
$isdst
- ) = localtime($time);
+ ) = localtime ($time);
# Adjust month
$mon++;
return $year, $mon, $mday, $hour, $min, $sec;
} # ymdhms
-sub julian($$$) {
+sub julian ($$$) {
my ($year, $month, $day) = @_;
my $days = 0;
return $days + $day;
} # julian
-sub _is_leap_year($) {
+sub _is_leap_year ($) {
my ($year) = @_;
-
+
return 0 if $year % 4;
return 1 if $year % 100;
return 0 if $year % 400;
-
+
return 1;
} # _is_leap_year
-sub Add($%) {
+sub Add ($%) {
my ($datetime, %parms) = @_;
-
+
=pod
=head2 Add ($datetime, %parms)
hours => $hours
days => $days
month => $month
-
+
Note that month will simply increment the month number, adjusting for overflow
of year if appropriate. Therefore a date of 2/28/2001 would increase by 1 month
to yield 3/28/2001. And, unfortunately, an increase of 1 month to 1/30/2011
'days',
'months',
);
-
- for (keys %parms) {
- unless (InArray($_, @validKeys)) {
+
+ foreach (keys %parms) {
+ unless (InArray ($_, @validKeys)) {
croak "Invalid key in DateUtils::Add: $_";
} # unless
- } # for
-
+ } # foreach
+
my $epochTime = DateToEpoch $datetime;
-
+
my $amount = 0;
-
+
$parms{seconds} ||= 0;
$parms{minutes} ||= 0;
$parms{hours} ||= 0;
$parms{days} ||= 0;
-
+
$amount += $parms{days} * $SECS_IN_DAY;
$amount += $parms{hours} * $SECS_IN_HOUR;
$amount += $parms{minutes} * $SECS_IN_MIN;
$amount += $parms{seconds};
-
+
$epochTime += $amount;
$datetime = EpochToDate $epochTime;
-
+
if ($parms{month}) {
my $years = $parms{month} / 12;
my $months = $parms{month} % 12;
-
+
my $month = substr $datetime, 5, 2;
-
+
$years += ($month + $months) / 12;
- substr($datetime, 5, 2) = ($month + $months) % 12;
-
- substr($datetime, 0, 4) = substr ($datetime, 0, 4) + $years;
+ substr ($datetime, 5, 2) = ($month + $months) % 12;
+
+ substr ($datetime, 0, 4) = substr ($datetime, 0, 4) + $years;
} # if
-
+
return $datetime;
} # Add
-sub Age($) {
+sub Age ($) {
my ($timestamp) = @_;
=pod
my $timestamp_days = julian $timestamp_year, $month, $day;
if ($timestamp_year > $today_year or
- ($timestamp_days > $today_days and $timestamp_year == $today_year)) {
+ ($timestamp_days > $today_days and $timestamp_year == $today_year)) {
return;
} else {
my $leap_days = 0;
for (my $i = $timestamp_year; $i < $today_year; $i++) {
-
+
$leap_days++ if $i % 4 == 0;
} # for
} # if
} # Age
-sub Compare($$) {
+sub Compare ($$) {
my ($date1, $date2) = @_;
-
+
=pod
=head2 Compare ($date2, $date2)
return DateToEpoch ($date1) <=> DateToEpoch ($date2);
} # Compare
-sub DateToEpoch($) {
+sub DateToEpoch ($) {
my ($date) = @_;
-
+
=pod
=head2 DateToEpoch ($datetime)
my $hour = substr $date, 11, 2;
my $minute = substr $date, 14, 2;
my $seconds = substr $date, 17, 2;
-
+
my $days;
for (my $i = 1970; $i < $year; $i++) {
$days += _is_leap_year ($i) ? 366 : 365;
} # for
-
+
my @monthDays = (
0,
31,
304,
334,
);
-
+
$days += $monthDays[$month - 1];
-
+
$days++
if _is_leap_year ($year) and $month > 2;
-
+
$days += $day - 1;
-
+
return ($days * $SECS_IN_DAY)
+ ($hour * $SECS_IN_HOUR)
+ ($minute * $SECS_IN_MIN)
+ $seconds;
} # DateToEpoch
-sub EpochToDate($) {
+sub EpochToDate ($) {
my ($epoch) = @_;
-
+
=pod
=head2 EpochToDate ($epoch)
my ($month, $day, $hour, $minute, $seconds);
my $leapYearSecs = 366 * $SECS_IN_DAY;
my $yearSecs = $leapYearSecs - $SECS_IN_DAY;
-
+
while () {
my $amount = _is_leap_year ($year) ? $leapYearSecs : $yearSecs;
-
+
last
if $amount > $epoch;
-
+
$epoch -= $amount;
$year++;
} # while
-
- my $leapYearAdjustment = _is_leap_year($year) ? 1 : 0;
-
+
+ my $leapYearAdjustment = _is_leap_year ($year) ? 1 : 0;
+
if ($epoch >= (334 + $leapYearAdjustment) * $SECS_IN_DAY) {
$month = '12';
$epoch -= (334 + $leapYearAdjustment) * $SECS_IN_DAY;
$month = '01';
} # if
- $day = int(($epoch / $SECS_IN_DAY) + 1);
+ $day = int (($epoch / $SECS_IN_DAY) + 1);
$epoch = $epoch % $SECS_IN_DAY;
- $hour = int($epoch / $SECS_IN_HOUR);
+ $hour = int ($epoch / $SECS_IN_HOUR);
$epoch = $epoch % $SECS_IN_HOUR;
- $minute = int($epoch / $SECS_IN_MIN);
+ $minute = int ($epoch / $SECS_IN_MIN);
$seconds = $epoch % $SECS_IN_MIN;
-
+
$day = "0$day" if $day < 10;
$hour = "0$hour" if $hour < 10;
$minute = "0$minute" if $minute < 10;
$seconds = "0$seconds" if $seconds < 10;
-
+
return "$year-$month-$day $hour:$minute:$seconds";
} # EpochToDate
-sub UTCTime($) {
+sub UTCTime ($) {
my ($datetime) = @_;
-
+
=pod
=head2 UTCTime ($epoch)
=cut
my @localtime = localtime;
- my ($sec, $min, $hour, $mday, $mon, $year) = gmtime(
+ my ($sec, $min, $hour, $mday, $mon, $year) = gmtime (
DateToEpoch ($datetime) - (timegm (@localtime) - timelocal (@localtime))
);
-
+
$year += 1900;
$mon++;
$hour = '0' . $hour if $hour < 10;
$mon = '0' . $mon if $mon < 10;
$mday = '0' . $mday if $mday < 10;
-
+
return "$year-$mon-${mday}T$hour:$min:${sec}Z";
} # UTCTime
-sub UTC2Localtime($) {
+sub UTC2Localtime ($) {
my ($utcdatetime) = @_;
-
+
# If the field does not look like a UTC time then just return it.
return $utcdatetime unless $utcdatetime =~ /\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}Z/;
);
} # UTC2Localtime
-sub FormatDate($) {
+sub FormatDate ($) {
my ($date) = @_;
=pod
. substr ($date, 0, 4);
} # FormatDate
-sub FormatTime($) {
+sub FormatTime ($) {
my ($time) = @_;
=pod
my $AmPm = $hours > 12 ? "Pm" : "Am";
$hours = $hours - 12 if $hours > 12;
-
+
$hours = "0$hours" if length $hours == 1;
return "$hours:$minutes $AmPm";
} # FormatTime
-sub MDY(;$) {
+sub MDY (;$) {
my ($time) = @_;
=pod
return "$mon/$mday/$year";
} # MDY
-sub SQLDatetime2UnixDatetime($) {
+sub SQLDatetime2UnixDatetime ($) {
my ($sqldatetime) = @_;
=pod
my $year = substr $sqldatetime, 0, 4;
my $month = substr $sqldatetime, 5, 2;
my $day = substr $sqldatetime, 8, 2;
- my $time = FormatTime(substr $sqldatetime, 11);
+ my $time = FormatTime (substr $sqldatetime, 11);
return $months{$month} . " $day, $year \@ $time";
} # SQLDatetime2UnixDatetime
-sub SubtractDays($$) {
+sub SubtractDays ($$) {
my ($timestamp, $nbr_of_days) = @_;
=pod
return $year . "-" . $month . "-" . $days . substr $timestamp, 10;
} # SubtractDays
-sub Today2SQLDatetime() {
+sub Today2SQLDatetime () {
=pod
return UnixDatetime2SQLDatetime (scalar (localtime));
} # Today2SQLDatetime
-sub UnixDatetime2SQLDatetime($) {
+sub UnixDatetime2SQLDatetime ($) {
my ($datetime) = @_;
=pod
unless ($months{$month_name}) {
$month_name = substr $datetime, 8, 3;
} # unless
-
+
my $month = $months{$month_name};
my $time = substr $datetime, 11, 8;
warning "Year undefined for $orig_datetime\nReturning today's date";
return Today2SQLDatetime;
} # unless
-
+
unless ($month) {
warning "Month undefined for $orig_datetime\nReturning today's date";
return Today2SQLDatetime;
} # unless
-
+
unless ($day) {
warning "Day undefined for $orig_datetime\nReturning today's date";
return Today2SQLDatetime;
return "$year-$month-$day $time";
} # UnixDatetime2SQLDatetime
-sub YMD(;$) {
+sub YMD (;$) {
my ($time) = @_;
=pod
return "$year$mon$mday";
} # YMD
-sub YMDHM(;$) {
+sub YMDHM (;$) {
my ($time) = @_;
=pod
return "$year$mon$mday\@$hour:$min";
} # YMDHM
-sub YMDHMS(;$) {
+sub YMDHMS (;$) {
my ($time) = @_;
=pod
return "$year$mon$mday\@$hour:$min:$sec";
} # YMDHMS
-sub timestamp(;$) {
+sub timestamp (;$) {
my ($time) = @_;
=pod
return "$year$mon${mday}_$hour$min$sec";
} # timestamp
-sub MDYHMS2SQLDatetime($) {
- my ($datetime) = @_;
-
- $datetime =~ s/^\s+|\s+$//g;
-
- my ($year, $mon, $day, $hour, $min, $sec, $ampm);
-
- # For datetime format of MM/DD/YYYY HH:MM:SS [Am|Pm]
- if ($datetime =~ /^(\d{1,2})\/(\d{1,2})\/(\d{4}) (\d{1,2}):(\d{1,2}):(\d{1,2}) (\w{2})$/) {
- $mon = $1;
- $day = $2;
- $year = $3;
- $hour = $4;
- $min = $5;
- $sec = $6;
- $ampm = $7;
- # For datetime format of MM/DD/YYYY HH:MM:SS
- } elsif ($datetime =~ /^(\d{1,2})\/(\d{1,2})\/(\d{4}) (\d{1,2}):(\d{1,2}):(\d{1,2})$/){
- $mon = $1;
- $day = $2;
- $year = $3;
- $hour = $4;
- $min = $5;
- $sec = $6;
- # For datetime format of MM/DD/YYYY
- } elsif ($datetime =~ /^(\d{1,2})\/(\d{1,2})\/(\d{4})$/) {
- $mon = $1;
- $day = $2;
- $year = $3;
- $hour = '00';
- $min = '00';
- $sec = '00';
- } else {
- return
- } # if
-
- # Range checks
- return if $mon > 12 or $mon <= 0;
- return if $day > 31 or $day <= 0;
- return if $hour > 23 or $hour < 0;
- return if $min > 59 or $min < 0;
-
- if ($day >= 31 and ($mon == 2
- or $mon == 4
- or $mon == 6
- or $mon == 9
- or $mon == 11)) {
- return;
- } # if
-
- return if $day > 29 and $mon == 2;
- return if $day == 29 and $mon == 2 and not _is_leap_year($year);
-
- # Convert to 24 hour time if necessary
- $hour += 12 if $ampm and $ampm =~ /pm/i;
-
- # Add any leading zeros
- $mon = "0$mon" if length $mon == 1;
- $day = "0$day" if length $day == 1;
- $hour = "0$hour" if length $hour == 1;
- $min = "0$min" if length $min == 1;
- $sec = "0$sec" if length $sec == 1;
-
- return "$year-$mon-$day $hour:$min:$sec";
-} # MDYHMS2SQLDatetime
-
1;
=head2 DEPENDENCIES
projects / clearscm.git / commitdiff