From 3c28a301742e8f8cdd35825fd6ebe4f842a510c7 Mon Sep 17 00:00:00 2001 From: Andrew DeFaria Date: Thu, 28 Feb 2019 17:06:24 -0700 Subject: [PATCH] Last batch of updates --- clearadm/clearadmscrub.pl | 81 ++++++-- clearadm/clearagent.pl | 7 +- clearadm/clearexec.pl | 25 ++- clearadm/cleartasks.pl | 72 +++---- clearadm/discovery.pl | 22 +- clearadm/index.cgi | 23 ++- clearadm/lib/Clearadm.pm | 389 ++++++++++++++++++++++-------------- clearadm/lib/ClearadmWeb.pm | 211 +++++++++---------- clearadm/lib/Clearexec.pm | 44 ++-- clearadm/lib/clearadm.sql | 108 ++++++---- clearadm/plot.cgi | 81 +++++--- clearadm/plotfs.cgi | 22 +- clearadm/plotloadavg.cgi | 23 ++- clearadm/plotstorage.cgi | 21 +- clearadm/processrunning.pl | 22 +- clearadm/readme.cgi | 7 +- clearadm/setup.pl | 52 ++--- clearadm/systems.cgi | 19 +- clearadm/test.pl | 140 ++++++------- clearadm/updateccfs.pl | 140 ++++++++++++- clearadm/updatefs.pl | 74 ++++--- clearadm/updatela.pl | 68 ++++--- clearadm/updatesystem.pl | 72 +++---- clearadm/viewager.cgi | 60 +++--- clearadm/viewdetails.cgi | 71 ++++--- clearadm/viewservers.cgi | 16 +- clearadm/vobdetails.cgi | 79 +++++--- clearadm/vobservers.cgi | 13 +- lib/Clearcase/View.pm | 132 ++++++------ lib/Clearcase/Vob.pm | 96 ++++----- lib/DateUtils.pm | 220 +++++++------------- 31 files changed, 1359 insertions(+), 1051 deletions(-) mode change 100755 => 100644 clearadm/viewager.cgi diff --git a/clearadm/clearadmscrub.pl b/clearadm/clearadmscrub.pl index c88ddac..1b8a6a4 100755 --- a/clearadm/clearadmscrub.pl +++ b/clearadm/clearadmscrub.pl @@ -1,4 +1,4 @@ -#!/usr/bin/env perl +#!/usr/local/bin/perl =pod @@ -49,6 +49,7 @@ use warnings; use FindBin; use Getopt::Long; +use Sys::Hostname; use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib"; @@ -65,52 +66,92 @@ my $clearadm = Clearadm->new; 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}"; @@ -120,11 +161,11 @@ $runlog{started} = Today2SQLDatetime; # 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 diff --git a/clearadm/clearagent.pl b/clearadm/clearagent.pl index fae4519..95b0571 100755 --- a/clearadm/clearagent.pl +++ b/clearadm/clearagent.pl @@ -80,7 +80,7 @@ my $clearexec; my $multithreaded = $Clearexec::CLEAROPTS{CLEAREXEC_MULTITHREADED}; my $daemon = 1; -GetOptions ( +GetOptions( 'usage' => sub { Usage }, 'verbose' => sub { set_verbose }, 'debug' => sub { set_debug }, @@ -94,14 +94,13 @@ Usage 'Extraneous options: ' . join ' ', @ARGV $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; diff --git a/clearadm/clearexec.pl b/clearadm/clearexec.pl index cd593e5..057caab 100755 --- a/clearadm/clearexec.pl +++ b/clearadm/clearexec.pl @@ -55,7 +55,7 @@ use warnings; use Getopt::Long; use FindBin; -use Term::ANSIColor qw (color); +use Term::ANSIColor qw(color); use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib"; @@ -77,18 +77,18 @@ my $port = $Clearexec::CLEAROPTS{CLEAREXEC_PORT}; 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; @@ -105,7 +105,7 @@ sub CmdLoop () { } # CmdLoop # Main -GetOptions ( +GetOptions( 'usage' => sub { Usage }, 'verbose' => sub { set_verbose }, 'debug' => sub { set_debug }, @@ -117,20 +117,19 @@ my $cmd = join ' ', @ARGV; 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"; diff --git a/clearadm/cleartasks.pl b/clearadm/cleartasks.pl index 25a297b..7e36b82 100755 --- a/clearadm/cleartasks.pl +++ b/clearadm/cleartasks.pl @@ -95,7 +95,7 @@ sub ToggleVerbose() { $SIG{USR1} = \&ToggleVerbose; -sub HandleSystemNotCheckingIn (%) { +sub HandleSystemNotCheckingIn(%) { my (%system) = @_; my $startTime = time; @@ -110,7 +110,7 @@ sub HandleSystemNotCheckingIn (%) { 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; @@ -123,8 +123,8 @@ sub HandleSystemNotCheckingIn (%) { $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";

Alert System not responding!

@@ -134,7 +134,7 @@ href="$runlogLink">not responding to clearagent requests. This can happen if clearagent is not setup and running on the system.

END - $clearadm->Notify ( + $clearadm->Notify( $notification{name}, $subject, $message, @@ -149,7 +149,7 @@ END return; } # HandleSystemNotCheckingIn -sub SystemsCheckin () { +sub SystemsCheckin() { for ($clearadm->FindSystem) { my %system = %$_; @@ -159,10 +159,7 @@ sub SystemsCheckin () { my $startTime = time; - my $status = $clearexec->connectToServer ( - $system{name}, - $system{port} - ); + my $status = $clearexec->connectToServer($system{name}, $system{port}); unless ($status) { HandleSystemNotCheckingIn %system; @@ -175,10 +172,7 @@ sub SystemsCheckin () { . "$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'; @@ -187,7 +181,7 @@ sub SystemsCheckin () { return; } # SystemsCheckin -sub UpdateRunlog ($$$$) { +sub UpdateRunlog($$$$) { my ($status, $startTime, $task, $output) = @_; my %runlog = ( @@ -215,28 +209,28 @@ sub UpdateRunlog ($$$$) { } # 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! @@ -290,12 +284,12 @@ END END $message .= join "\n", @output; $message .= ""; - $clearadm->Error ($message, -1); + $clearadm->Error($message, -1); last; } # if - $clearadm->Notify ( + $clearadm->Notify( $notification, $subject, $message, @@ -309,7 +303,7 @@ END 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. @@ -347,7 +341,7 @@ sub ProcessFilesystemErrors ($$$$@) { push @fsinfo, @{$system{$systemName}}; } # if - my $systemLink = MakeSystemLink ($systemName); + my $systemLink = MakeSystemLink($systemName); my $subject = 'Filesystem has exceeded threshold'; my $message = <<"END";
@@ -372,7 +366,7 @@ END $message .= ""; - $clearadm->Notify ( + $clearadm->Notify( $notification, $subject, $message, @@ -386,7 +380,7 @@ END return; } # ProcessFilesystemErrors -sub NonZeroReturn ($$$$$$) { +sub NonZeroReturn($$$$$$) { my ($system, $notification, $status, $lastid, $output, $task) = @_; my @output = @{$output}; @@ -424,7 +418,7 @@ END $message .= ""; - $clearadm->Notify ( + $clearadm->Notify( $notification, $subject, $message, @@ -437,7 +431,7 @@ END return; } # NonZeroReturn -sub ExecuteTask ($%) { +sub ExecuteTask($%) { my ($sleep, %task) = @_; my ($status, @output, %system, $subject, $message); @@ -466,7 +460,7 @@ sub ExecuteTask ($%) { . "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; @@ -480,7 +474,7 @@ sub ExecuteTask ($%) { if ($status != 0) { if ($notification{cond} and $notification{cond} =~ /non zero return/i) { - NonZeroReturn ( + NonZeroReturn( $system{name}, $notification{name}, $status, @@ -489,20 +483,20 @@ sub ExecuteTask ($%) { \%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; @@ -510,7 +504,7 @@ sub ExecuteTask ($%) { } # ExecuteTask # Main -GetOptions ( +GetOptions( 'usage' => sub { Usage }, 'verbose' => sub { set_verbose }, 'debug' => sub { set_debug }, @@ -518,11 +512,9 @@ GetOptions ( '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; diff --git a/clearadm/discovery.pl b/clearadm/discovery.pl index 49b4b3f..d765363 100755 --- a/clearadm/discovery.pl +++ b/clearadm/discovery.pl @@ -72,7 +72,7 @@ my $clearadm = Clearadm->new; my $broadcastTime = 10; -sub discover ($) { +sub discover($) { my ($broadcast) = @_; my $startTime = time; @@ -96,8 +96,7 @@ sub discover ($) { } # unless } # if - last - if (time () - $startTime) > $broadcastTime; + last if (time() - $startTime) > $broadcastTime; } # while verbose "$broadcastTime seconds has elapsed - discovery complete"; @@ -106,9 +105,9 @@ sub discover ($) { } # 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 }, @@ -116,8 +115,7 @@ GetOptions ( '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"; @@ -147,17 +145,15 @@ verbose_nolf "Found $nbrHosts host"; 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 diff --git a/clearadm/index.cgi b/clearadm/index.cgi index 4fc9cec..df9a74a 100755 --- a/clearadm/index.cgi +++ b/clearadm/index.cgi @@ -42,8 +42,9 @@ use warnings; 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"; @@ -57,7 +58,7 @@ use Utils; my $clearadm = Clearadm->new; # Main -GetOptions ( +GetOptions( 'usage' => sub { Usage }, 'verbose' => sub { set_verbose }, 'debug' => sub { set_debug }, @@ -94,7 +95,7 @@ my @systems = $clearadm->FindSystem; $perRow = @systems if @systems < $perRow; -foreach (@systems) { +for (@systems) { my %system = %{$_}; if ($i++ % $perRow == 0) { @@ -106,8 +107,7 @@ foreach (@systems) { my $data; - $data = '' - if $system{active} eq 'false'; + $data = '' if $system{active} eq 'false'; $data .= a { href => "systemdetails.cgi?system=$system{name}" @@ -115,7 +115,7 @@ foreach (@systems) { 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!', @@ -123,22 +123,25 @@ foreach (@systems) { }; } # if + my $image = $system{loadavgsmall} + ? "data:image/png;base64,$system{loadavgsmall}" + : "plotloadavg.cgi?system=$system{name}&tiny=1"; + $data .= '
' . 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 .= '' - if $system{active} eq 'false'; + $data .= '' if $system{active} eq 'false'; $load{uptime} ||= 'Unknown'; display td {class => 'dataCentered'}, "$data ", font {class => 'dim' }, "
Up: $load{uptime}"; -} # foreach +} # for while ($i % $perRow != 0) { $i++; diff --git a/clearadm/lib/Clearadm.pm b/clearadm/lib/Clearadm.pm index 4205e44..1f74aaf 100644 --- a/clearadm/lib/Clearadm.pm +++ b/clearadm/lib/Clearadm.pm @@ -38,7 +38,7 @@ specifics about the method you are envoking. my $clearadm = new Clearadm; # Add a new system - my %system = ( + my %system =( name => 'jupiter', alias => 'defaria.com', admin => 'Andrew DeFaria', @@ -47,13 +47,13 @@ specifics about the method you are envoking. 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 = ( @@ -64,7 +64,7 @@ specifics about the method you are envoking. # 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 @@ -98,6 +98,8 @@ use DateUtils; use Display; use GetConfig; use Mail; +use Clearcase::Vob; +use Clearcase::View; my $conf = dirname(__FILE__) . '/../etc/clearadm.conf'; @@ -155,8 +157,7 @@ sub _formatValues(@) { 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 @@ -166,8 +167,7 @@ sub _formatNameValues(%) { my @nameValueStrs; - push @nameValueStrs, "$_=" . $self->{db}->quote($rec{$_}) - for (keys %rec); + push @nameValueStrs, "$_=" . $self->{db}->quote($rec{$_}) for (keys %rec); return @nameValueStrs; } # _formatNameValues @@ -194,8 +194,7 @@ sub _deleteRecord($;$) { 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); @@ -213,12 +212,10 @@ sub _deleteRecord($;$) { $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); @@ -234,8 +231,7 @@ sub _updateRecord($$%) { my $statement = "update $table set "; $statement .= join ',', $self->_formatNameValues(%rec); - $statement .= " where $condition" - if $condition; + $statement .= " where $condition" if $condition; $self->{db}->do($statement); @@ -255,8 +251,7 @@ sub _checkRequiredFields($$) { } # if } # for - return "$fieldname is required" - unless $found; + return "$fieldname is required" unless $found; } # for return; @@ -337,7 +332,7 @@ sub _aliasSystem($) { if ($system{name}) { return $system{name}; } else { - return; + return; } # if } # _aliasSystem @@ -444,8 +439,7 @@ sub AddSystem(%) { my $result = _checkRequiredFields \@requiredFields, \%system; - return -1, "AddSystem: $result" - if $result; + return -1, "AddSystem: $result" if $result; $system{loadavgHist} ||= $defaultLoadavgHist; @@ -467,8 +461,7 @@ sub UpdateSystem ($%) { sub GetSystem($) { my ($self, $system) = @_; - return - unless $system; + return unless $system; my @records = $self->_getRecords( 'system', @@ -478,7 +471,7 @@ sub GetSystem($) { if ($records[0]) { return %{$records[0]}; } else { - return; + return; } # if } # GetSystem @@ -511,8 +504,7 @@ sub AddPackage(%) { my $result = _checkRequiredFields \@requiredFields, \%package; - return -1, "AddPackage: $result" - if $result; + return -1, "AddPackage: $result" if $result; return $self->_addRecord('package', %package); } # AddPackage @@ -530,8 +522,7 @@ sub UpdatePackage($$%) { $system = $self->_aliasSystem($system); - return - unless $system; + return unless $system; return $self->_updateRecord('package', "system='$system'", %update); } # UpdatePackage @@ -541,11 +532,8 @@ sub GetPackage($$) { $system = $self->_aliasSystem($system); - return - unless $system; - - return - unless $name; + return unless $system; + return unless $name; my @records = $self->_getRecords( 'package', @@ -555,7 +543,7 @@ sub GetPackage($$) { if ($records[0]) { return %{$records[0]}; } else { - return; + return; } # if } # GetPackage @@ -566,8 +554,7 @@ sub FindPackage($;$) { $system = $self->_aliasSystem($system); - return - unless $system; + return unless $system; my $condition = "system='$system' and name like '%$name%'"; @@ -585,8 +572,7 @@ sub AddFilesystem(%) { my $result = _checkRequiredFields \@requiredFields, \%filesystem; - return -1, "AddFilesystem: $result" - if $result; + return -1, "AddFilesystem: $result" if $result; # Default filesystem threshold $filesystem{threshold} ||= $defaultFilesystemThreshold; @@ -599,8 +585,7 @@ sub DeleteFilesystem($$) { $system = $self->_aliasSystem($system); - return - unless $system; + return unless $system; return $self->_deleteRecord( 'filesystem', @@ -613,8 +598,7 @@ sub UpdateFilesystem($$%) { $system = $self->_aliasSystem($system); - return - unless $system; + return unless $system; return $self->_updateRecord( 'filesystem', @@ -628,11 +612,8 @@ sub GetFilesystem($$) { $system = $self->_aliasSystem($system); - return - unless $system; - - return - unless $filesystem; + return unless $system; + return unless $filesystem; my @records = $self->_getRecords( 'filesystem', @@ -653,8 +634,7 @@ sub FindFilesystem($;$) { $system = $self->_aliasSystem($system); - return - unless $system; + return unless $system; my $condition = "system='$system' and filesystem like '%$filesystem%'"; @@ -665,71 +645,112 @@ sub AddVob(%) { 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($$) { @@ -747,22 +768,16 @@ 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 @@ -791,8 +806,7 @@ sub TrimFS($$) { my %filesystem = $self->GetFilesystem($system, $filesystem); - return - unless %filesystem; + return unless %filesystem; my %task = $self->GetTask('scrub'); @@ -817,8 +831,7 @@ sub TrimFS($$) { ); if ($dbmsg eq 'Records deleted') { - return (0, $dbmsg) - if $dberr == 0; + return (0, $dbmsg) if $dberr == 0; my %runlog; @@ -841,8 +854,7 @@ sub TrimLoadavg($) { my %system = $self->GetSystem($system); - return - unless %system; + return unless %system; my %task = $self->GetTask('loadavg'); @@ -867,8 +879,7 @@ sub TrimLoadavg($) { ); if ($dbmsg eq 'Records deleted') { - return (0, $dbmsg) - if $dberr == 0; + return (0, $dbmsg) if $dberr == 0; my %runlog; @@ -886,16 +897,111 @@ sub TrimLoadavg($) { 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'; @@ -979,11 +1085,8 @@ sub GetLatestFS($$) { $system = $self->_aliasSystem($system); - return - unless $system; - - return - unless $filesystem; + return unless $system; + return unless $filesystem; my @records = $self->_getRecords( 'fs', @@ -992,9 +1095,9 @@ sub GetLatestFS($$) { ); if ($records[0]) { - return %{$records[0]}; + return %{$records[0]}; } else { - return; + return; } # if } # GetLatestFS @@ -1007,8 +1110,7 @@ sub AddLoadavg() { my $result = _checkRequiredFields \@requiredFields, \%loadavg; - return -1, "AddLoadavg: $result" - if $result; + return -1, "AddLoadavg: $result" if $result; # Timestamp record $loadavg{timestamp} = Today2SQLDatetime; @@ -1021,8 +1123,7 @@ sub GetLoadavg($;$$$$) { $system = $self->_aliasSystem($system); - return - unless $system; + return unless $system; $interval ||= 'Minute'; @@ -1055,8 +1156,7 @@ sub GetLoadavg($;$$$$) { 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 @@ -1105,8 +1205,7 @@ sub GetLatestLoadavg($) { $system = $self->_aliasSystem($system); - return - unless $system; + return unless $system; my @records = $self->_getRecords( 'loadavg', @@ -1121,7 +1220,7 @@ sub GetLatestLoadavg($) { } # if } # GetLatestLoadavg -sub GetStorage($$$;$$$$$) { +sub GetStoragePool($$$;$$$$$) { my ($self, $type, $tag, $storage, $region, $start, $end, $count, $interval) = @_; $interval ||= 'Day'; @@ -1140,6 +1239,10 @@ sub GetStorage($$$;$$$$$) { 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'; @@ -1200,7 +1303,7 @@ END } # while return @records; -} # GetStorage +} # GetStoragePool sub AddTask(%) { my ($self, %task) = @_; @@ -1212,8 +1315,7 @@ sub AddTask(%) { my $result = _checkRequiredFields \@requiredFields, \%task; - return -1, "AddTask: $result" - if $result; + return -1, "AddTask: $result" if $result; return $self->_addRecord('task', %task); } # AddTask @@ -1237,8 +1339,7 @@ sub FindTask($) { sub GetTask($) { my ($self, $name) = @_; - return - unless $name; + return unless $name; my @records = $self->_getRecords('task', "name='$name'"); @@ -1264,8 +1365,7 @@ sub AddSchedule(%) { my $result = _checkRequiredFields \@requiredFields, \%schedule; - return -1, "AddSchedule: $result" - if $result; + return -1, "AddSchedule: $result" if $result; return $self->_addRecord('schedule', %schedule); } # AddSchedule @@ -1280,7 +1380,7 @@ sub FindSchedule(;$$) { my ($self, $name, $task) = @_; $name ||= ''; - $task||= ''; + $task ||= ''; my $condition = "name like '%$name%'"; $condition .= ' and '; @@ -1316,8 +1416,7 @@ sub AddRunlog(%) { my $result = _checkRequiredFields \@requiredFields, \%runlog; - return -1, "AddRunlog: $result" - if $result; + return -1, "AddRunlog: $result" if $result; $runlog{ended} = Today2SQLDatetime; @@ -1379,8 +1478,7 @@ sub FindRunlog(;$$$$$$) { sub GetRunlog($) { my ($self, $id) = @_; - return - unless $id; + return unless $id; my @records = $self->_getRecords('runlog', "id=$id"); @@ -1603,8 +1701,7 @@ sub AddAlert(%) { my $result = _checkRequiredFields \@requiredFields, \%alert; - return -1, "AddAlert: $result" - if $result; + return -1, "AddAlert: $result" if $result; return $self->_addRecord('alert', %alert); } # AddAlert @@ -1852,8 +1949,7 @@ sub Notify($$$$$$) { # 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; @@ -1936,8 +2032,7 @@ sub ClearNotifications($$;$) { my %system = $self->GetSystem($system); - return - unless $system; + return unless $system; if ($system{notification} and $system{notification} eq 'Filesystem' and @@ -1963,13 +2058,11 @@ sub SystemAlive(%) { # 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}; @@ -2018,8 +2111,7 @@ sub AddAlertlog(%) { my $result = _checkRequiredFields \@requiredFields, \%alertlog; - return -1, "AddAlertlog: $result" - if $result; + return -1, "AddAlertlog: $result" if $result; # Timestamp record $alertlog{timestamp} = Today2SQLDatetime; @@ -2054,10 +2146,10 @@ sub FindAlertlog(;$$$$$) { $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 @@ -2065,8 +2157,7 @@ sub FindAlertlog(;$$$$$) { sub GetAlertlog($) { my ($self, $alert) = @_; - return - unless $alert; + return unless $alert; my @records = $self->_getRecords('alertlog', "alert='$alert'"); @@ -2098,8 +2189,7 @@ sub AddNotification(%) { my $result = _checkRequiredFields \@requiredFields, \%notification; - return -1, "AddNotification: $result" - if $result; + return -1, "AddNotification: $result" if $result; return $self->_addRecord('notification', %notification); } # AddNotification @@ -2125,8 +2215,7 @@ sub FindNotification(;$$) { sub GetNotification($) { my ($self, $name) = @_; - return - unless $name; + return unless $name; my @records = $self->_getRecords('notification', "name='$name'"); diff --git a/clearadm/lib/ClearadmWeb.pm b/clearadm/lib/ClearadmWeb.pm index 54f164e..e5848b0 100644 --- a/clearadm/lib/ClearadmWeb.pm +++ b/clearadm/lib/ClearadmWeb.pm @@ -47,7 +47,7 @@ use strict; use base 'Exporter'; -use CGI qw ( +use CGI qw( :standard start_a end_a @@ -85,7 +85,7 @@ our $APPNAME= 'Clearadm'; our $VERSION = '$Revision: 1.46 $'; ($VERSION) = ($VERSION =~ /\$Revision: (.*) /); -our @EXPORT = qw ( +our @EXPORT = qw( autoScale displayError displayAlert @@ -165,7 +165,7 @@ our @PREDEFINED_MULTIPLIERS = ( 'Days', ); -sub dbug ($) { +sub dbug($) { my ($msg) = @_; display font ({-class => 'error'}, '
DEBUG: '). $msg; @@ -173,7 +173,7 @@ sub dbug ($) { return; } # dbug -sub displayError ($) { +sub displayError($) { my ($msg) = @_; display font ({-class => 'error'}, 'Error: ') . $msg; @@ -181,7 +181,7 @@ sub displayError ($) { return } # displayError; -sub setField ($;$) { +sub setField($;$) { my ($field, $label) = @_; $label ||= 'Unknown'; @@ -191,7 +191,7 @@ sub setField ($;$) { return defined $field ? $field : $undef; } # setField -sub setFields ($%) { +sub setFields($%) { my ($label, %rec) = @_; $rec{$_} = setField ($rec{$_}, $label) @@ -200,7 +200,7 @@ sub setFields ($%) { return %rec; } # setFields; -sub dumpVars (%) { +sub dumpVars(%) { my (%vars) = @_; for (keys %vars) { @@ -210,7 +210,7 @@ sub dumpVars (%) { return; } # dumpVars -sub graphError ($) { +sub graphError($) { my ($msg) = @_; use GD; @@ -240,7 +240,7 @@ sub graphError ($) { exit; } # graphError -sub autoScale ($) { +sub autoScale($) { my ($amount) = @_; my $kbyte = 1024; @@ -256,7 +256,7 @@ sub autoScale ($) { return $size; } # autoScale -sub _makeAlertlogSelection ($$) { +sub _makeAlertlogSelection($$) { my ($name, $default) = @_; $default ||= 'All'; @@ -278,7 +278,7 @@ sub _makeAlertlogSelection ($$) { return $dropdown; } # _makeAlertlogSelection -sub _makeRunlogSelection ($$) { +sub _makeRunlogSelection($$) { my ($name, $default) = @_; $default ||= 'All'; @@ -308,7 +308,7 @@ sub _makeRunlogSelection ($$) { return $dropdown; } # _makeRunlogSelection -sub _makeRunlogSelectionNumeric ($$) { +sub _makeRunlogSelectionNumeric($$) { my ($name, $default) = @_; $default ||= 'All'; @@ -327,15 +327,14 @@ sub _makeRunlogSelectionNumeric ($$) { 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 { @@ -348,7 +347,7 @@ sub makeAlertDropdown (;$$) { return $dropdown; } # makeAlertDropdown -sub makeMultiplierDropdown (;$$) { +sub makeMultiplierDropdown(;$$) { my ($label, $default) = @_; $label ||= ''; @@ -364,7 +363,7 @@ sub makeMultiplierDropdown (;$$) { return $dropdown; } # makeMultiplierDropdown -sub makeNoMoreThanDropdown (;$$) { +sub makeNoMoreThanDropdown(;$$) { my ($label, $default) = @_; $label ||= ''; @@ -413,7 +412,7 @@ sub makeStoragePoolDropdown($$) { my @values; - my $dropdown = 'Storage pool '; + my $dropdown = 'Storage pool '; if ($type eq 'vob') { push @values, qw(admin db cleartext derivedobj source total); @@ -431,7 +430,7 @@ sub makeStoragePoolDropdown($$) { return span {id => $type}, $dropdown; } # makeStoragePoolsDropdown -sub makeFilesystemDropdown ($;$$$) { +sub makeFilesystemDropdown($;$$$) { my ($system, $label, $default, $onchange) = @_; $label ||= ''; @@ -459,7 +458,7 @@ sub makeFilesystemDropdown ($;$$$) { return span {id => 'filesystems'}, $dropdown; } # makeFilesystemDropdown -sub makeIntervalDropdown (;$$$) { +sub makeIntervalDropdown(;$$$) { my ($label, $default, $onchange) = @_; $label ||= ''; @@ -471,8 +470,7 @@ sub makeIntervalDropdown (;$$$) { 'Month', ); - $default = ucfirst lc $default - if $default; + $default = ucfirst lc $default if $default; my $dropdown = "$label "; $dropdown .= popup_menu { @@ -487,7 +485,7 @@ sub makeIntervalDropdown (;$$$) { return span {id => 'scaling'}, $dropdown; } # makeIntervalDropdown; -sub makeNotificationDropdown (;$$) { +sub makeNotificationDropdown(;$$) { my ($label, $default) = @_; $label ||= ''; @@ -508,7 +506,7 @@ sub makeNotificationDropdown (;$$) { return $dropdown; } # makeNotificationDropdown -sub makeRestartableDropdown (;$$) { +sub makeRestartableDropdown(;$$) { my ($label, $default) = @_; $label ||= ''; @@ -529,7 +527,7 @@ sub makeRestartableDropdown (;$$) { return $dropdown; } # makeRestartableDropdown -sub makeSystemDropdown (;$$$%) { +sub makeSystemDropdown(;$$$%) { my ($label, $default, $onchange, %systems) = @_; $label ||= ''; @@ -556,7 +554,7 @@ sub makeSystemDropdown (;$$$%) { return span {id => 'systems'}, $systemDropdown; } # makeSystemDropdown -sub makeTaskDropdown (;$$) { +sub makeTaskDropdown(;$$) { my ($label, $default) = @_; $label ||= ''; @@ -577,7 +575,7 @@ sub makeTaskDropdown (;$$) { return $taskDropdown; } # makeTaskDropdown -sub makeTimeDropdown ($$$;$$$$$) { +sub makeTimeDropdown($$$;$$$$$) { my ( $table, $elementID, @@ -622,7 +620,7 @@ sub makeTimeDropdown ($$$;$$$$$) { return $timeDropdown; } # makeTimeDropdown -sub heading (;$$) { +sub heading(;$$) { my ($title, $type) = @_; if ($title) { @@ -633,17 +631,17 @@ sub heading (;$$) { display header; display start_html { - -title => $title, - -author => 'Andrew DeFaria ', - -meta => { - keywords => 'ClearSCM Clearadm', + -title => $title, + -author => 'Andrew DeFaria ', + -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; @@ -762,7 +760,7 @@ sub heading (;$$) { return; } # heading -sub displayAlert (;$) { +sub displayAlert(;$) { my ($alert) = @_; display start_table {cellspacing => 1}; @@ -862,7 +860,7 @@ sub displayAlert (;$) { return; } # DisplayAlerts -sub displayAlertlog (%) { +sub displayAlertlog(%) { my (%opts) = @_; my $optsChanged; @@ -1085,7 +1083,7 @@ sub displayAlertlog (%) { return; } # displayAlertlog -sub displayFilesystem ($) { +sub displayFilesystem($) { my ($systemName) = @_; display start_table {cellspacing => 1, width => '98%'}; @@ -1213,13 +1211,17 @@ sub displayFilesystem ($) { display td {class => $classRightTop}, "$used ($usedPct%)
", 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; @@ -1231,7 +1233,7 @@ sub displayFilesystem ($) { return; } # displayFilesystem -sub displayNotification (;$) { +sub displayNotification(;$) { my ($notification) = @_; display start_table {cellspacing => 1}; @@ -1331,7 +1333,7 @@ sub displayNotification (;$) { return; } # displayNotification -sub displayRunlog (%) { +sub displayRunlog(%) { my (%opts) = @_; my $optsChanged; @@ -1563,7 +1565,7 @@ sub displayRunlog (%) { return; } # displayRunlog -sub displaySchedule () { +sub displaySchedule() { display start_table {cellspacing => 1}; display start_Tr; @@ -1668,7 +1670,7 @@ sub displaySchedule () { return; } # displaySchedule -sub displaySystem ($) { +sub displaySystem($) { my ($systemName) = @_; my %system = $clearadm->GetSystem ($systemName); @@ -1785,7 +1787,7 @@ sub displaySystem ($) { 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, }; @@ -1850,58 +1852,59 @@ sub displaySystem ($) { 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}; @@ -1917,10 +1920,8 @@ sub displaySystem ($) { . "&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 @@ -1930,7 +1931,7 @@ sub displaySystem ($) { return; } # displaySystem -sub displayTask (;$) { +sub displayTask(;$) { my ($task) = @_; display start_table {cellspacing => 1, width => '98%'}; @@ -2029,7 +2030,7 @@ sub displayTask (;$) { return; } # DisplayAlerts -sub editAlert (;$) { +sub editAlert(;$) { my ($alert) = @_; display start_form ( @@ -2110,7 +2111,7 @@ sub editAlert (;$) { return; } # editAlert -sub editFilesystem ($$) { +sub editFilesystem($$) { my ($system, $filesystem) = @_; display start_form ( @@ -2211,7 +2212,7 @@ sub editFilesystem ($$) { return; } # editFilesytem -sub editNotification (;$) { +sub editNotification(;$) { my ($notification) = @_; display start_form ( @@ -2296,7 +2297,7 @@ sub editNotification (;$) { return; } # editNotification -sub editSchedule (;$) { +sub editSchedule(;$) { my ($schedule) = @_; display start_form ( @@ -2399,7 +2400,7 @@ sub editSchedule (;$) { return; } # editSchedule -sub editSystem (;$) { +sub editSystem(;$) { my ($system) = @_; display start_form ( @@ -2584,7 +2585,7 @@ sub editSystem (;$) { return; } # editSystem -sub editTask (;$) { +sub editTask(;$) { my ($task) = @_; display start_form ( @@ -2685,7 +2686,7 @@ sub editTask (;$) { return; } # editTask -sub footing () { +sub footing() { my $clearscm = a {-href => 'http://clearscm.com'}, 'ClearSCM, Inc.'; # Figure out which script by using CLEARADM_BASE. diff --git a/clearadm/lib/Clearexec.pm b/clearadm/lib/Clearexec.pm index 410a94e..461f86d 100644 --- a/clearadm/lib/Clearexec.pm +++ b/clearadm/lib/Clearexec.pm @@ -81,7 +81,7 @@ $CLEAROPTS{CLEAREXEC_PORT} = $ENV{CLEAREXEC_PORT} $CLEAROPTS{CLEAREXEC_MULTITHREADED} = $ENV{CLEAREXEC_MULTITHREADED} if $ENV{CLEAREXEC_MULTITHREADED}; -sub new () { +sub new() { my ($class) = @_; my $clearadm = bless {}, $class; @@ -91,7 +91,7 @@ sub new () { return $clearadm; } # new -sub _tag ($) { +sub _tag($) { my ($self, $msg) = @_; my $tag = YMDHMS; @@ -101,7 +101,7 @@ sub _tag ($) { return "$tag$msg"; } # _tag -sub _verbose ($) { +sub _verbose($) { my ($self, $msg) = @_; verbose $self->_tag ($msg); @@ -109,7 +109,7 @@ sub _verbose ($) { return; } # _verbose -sub _debug ($) { +sub _debug($) { my ($self, $msg) = @_; debug $self->_tag ($msg); @@ -117,7 +117,7 @@ sub _debug ($) { return; } # _debug -sub _log ($) { +sub _log($) { my ($self, $msg) = @_; display $self->_tag ($msg); @@ -125,7 +125,7 @@ sub _log ($) { return; } # log -sub _endServer () { +sub _endServer() { display "Clearexec V$VERSION shutdown at " . localtime; # Kill process group @@ -133,7 +133,6 @@ sub _endServer () { # Wait for all children to die while (wait != -1) { - # do nothing } # while @@ -141,7 +140,7 @@ sub _endServer () { exit; } # _endServer -sub _restartServer () { +sub _restartServer() { # Not sure what to do on a restart server display 'Entered _restartServer'; @@ -149,7 +148,7 @@ sub _restartServer () { return; } # _restartServer -sub setMultithreaded ($) { +sub setMultithreaded($) { my ($self, $value) = @_; my $oldValue = $self->{multithreaded}; @@ -159,13 +158,13 @@ sub setMultithreaded ($) { 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}; @@ -179,8 +178,7 @@ sub connectToServer (;$$) { return unless $self->{socket}; - $self->{socket}->autoflush - if $self->{socket}; + $self->{socket}->autoflush if $self->{socket}; $self->{host} = $host; $self->{port} = $port; @@ -194,7 +192,7 @@ sub connectToServer (;$$) { return; } # connectToServer -sub disconnectFromServer () { +sub disconnectFromServer() { my ($self) = @_; undef $self->{socket}; @@ -202,11 +200,10 @@ sub disconnectFromServer () { 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, '', ()); @@ -230,14 +227,13 @@ sub execute ($) { 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 @@ -274,8 +270,7 @@ sub _serviceClient ($$) { $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; @@ -295,7 +290,7 @@ sub _serviceClient ($$) { return; } # _serviceClient -sub startServer (;$) { +sub startServer(;$) { my ($self, $port) = @_; $port ||= $CLEAROPTS{CLEAREXEC_PORT}; @@ -308,8 +303,7 @@ sub startServer (;$) { 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); diff --git a/clearadm/lib/clearadm.sql b/clearadm/lib/clearadm.sql index e722015..7142ad9 100644 --- a/clearadm/lib/clearadm.sql +++ b/clearadm/lib/clearadm.sql @@ -56,6 +56,8 @@ create table system ( '1 year' ) not null default '6 months', loadavgThreshold float (4,2) default 5.00, + loadavgsmall blob, + loadavg blob, primary key (name) ) engine=innodb; -- system @@ -130,6 +132,8 @@ create table filesystem ( '11 months', '1 year' ) not null default '6 months', + fssmall blob, + fslarge blob, key filesystemIndex (filesystem), foreign key systemLink (system) references system (name) @@ -160,18 +164,22 @@ create table fs ( -- 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 @@ -185,8 +193,12 @@ create table viewstorage ( 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 @@ -203,43 +215,55 @@ create table loadavg ( 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 ( diff --git a/clearadm/plot.cgi b/clearadm/plot.cgi index 9fada55..fa3d45a 100755 --- a/clearadm/plot.cgi +++ b/clearadm/plot.cgi @@ -39,7 +39,7 @@ use strict; 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"; @@ -55,7 +55,7 @@ my %opts = Vars; my $clearadm; -sub displayGraph () { +sub displayGraph() { my $parms; for (keys %opts) { @@ -66,36 +66,66 @@ sub displayGraph () { display '
'; 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 '
'; - 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}; @@ -161,20 +191,20 @@ sub displayControls() { 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}, @@ -184,7 +214,7 @@ sub displayControls() { $opts{scaling}, ); - my $endButtons = makeTimeDropdown ( + my $endButtons = makeTimeDropdown( $opts{type}, 'endTimestamp', $opts{system}, @@ -204,7 +234,7 @@ sub displayControls() { $update = ''; # TODO do I need something here? } # if - my $intervalButtons = makeIntervalDropdown ( + my $intervalButtons = makeIntervalDropdown( 'Interval', $opts{scaling}, $update @@ -264,7 +294,7 @@ sub displayControls() { $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}; @@ -281,7 +311,8 @@ display start_form { }; # 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; diff --git a/clearadm/plotfs.cgi b/clearadm/plotfs.cgi index 8617e79..e02bd10 100755 --- a/clearadm/plotfs.cgi +++ b/clearadm/plotfs.cgi @@ -61,6 +61,7 @@ use strict; use warnings; use FindBin; +use Convert::Base64; use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib"; @@ -68,7 +69,7 @@ use Clearadm; use ClearadmWeb; use Display; -use CGI qw (:standard :cgi-lib); +use CGI qw(:standard :cgi-lib); use GD::Graph::area; my %opts = Vars; @@ -89,7 +90,7 @@ if ($opts{tiny}) { 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}; @@ -100,7 +101,7 @@ graphError "Filesystem is required" 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}, @@ -116,7 +117,7 @@ my (@x, @y); my $i = 0; -foreach (@fs) { +for (@fs) { $i++; my %fs = %{$_}; @@ -128,7 +129,8 @@ foreach (@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 @@ -144,7 +146,7 @@ my $title = $opts{tiny} ? '' : "Filesystem usage for " . "$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, @@ -165,8 +167,12 @@ $graph->set ( 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 diff --git a/clearadm/plotloadavg.cgi b/clearadm/plotloadavg.cgi index c8acbfa..d5cb7ca 100755 --- a/clearadm/plotloadavg.cgi +++ b/clearadm/plotloadavg.cgi @@ -59,6 +59,7 @@ use strict; use warnings; use FindBin; +use Convert::Base64; use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib"; @@ -66,7 +67,7 @@ use Clearadm; use ClearadmWeb; use Display; -use CGI qw (:standard :cgi-lib); +use CGI qw(:standard :cgi-lib); use GD::Graph::area; my %opts = Vars; @@ -87,7 +88,7 @@ if ($opts{tiny}) { 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}; @@ -95,12 +96,12 @@ graphError "System is required" 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" @@ -108,7 +109,7 @@ graphError "No loadavg data" my (@x, @y); -foreach (@loads) { +for (@loads) { my %load = %{$_}; if ($opts{tiny}) { @@ -118,7 +119,7 @@ foreach (@loads) { } # if push @y, $load{loadavg}; -} # foreach +} # for my @data = ([@x], [@y]); @@ -133,7 +134,7 @@ my $y_label = $opts{tiny} ? '' : 'Load'; 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, @@ -154,8 +155,12 @@ $graph->set ( 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 diff --git a/clearadm/plotstorage.cgi b/clearadm/plotstorage.cgi index 22c20ba..d879ef3 100755 --- a/clearadm/plotstorage.cgi +++ b/clearadm/plotstorage.cgi @@ -40,7 +40,7 @@ $Date: 2011/01/14 16:37:04 $ : Name of the Clearcase storage pool to plot information for : Height of chart (Default: 480px - tiny: 40) : Width of chart (Default: 800px - tiny: 150) - : A GD::Color color value (Default: lblue) + : A GD::Color color value (Default: purple) : Currently one of Minute, Hour, Day or Month. Specifies how Clearadm::GetFS will scale the data returned (Default: Minute - tiny: Day) @@ -61,6 +61,7 @@ use strict; use warnings; use FindBin; +use Convert::Base64; use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib"; @@ -69,7 +70,7 @@ use ClearadmWeb; use Clearcase; use Display; -use CGI qw (:standard :cgi-lib); +use CGI qw(:standard :cgi-lib); use GD::Graph::area; my %opts = Vars; @@ -77,7 +78,7 @@ 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; @@ -90,7 +91,7 @@ if ($opts{tiny}) { 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}; @@ -99,7 +100,7 @@ graphError "Storage is required" unless $opts{storage}; 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}, @@ -147,7 +148,7 @@ my $title = $opts{tiny} ? '' : "Storage usage for " . "$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, @@ -168,8 +169,12 @@ $graph->set ( 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 diff --git a/clearadm/processrunning.pl b/clearadm/processrunning.pl index c5a2a4f..cca1d7c 100755 --- a/clearadm/processrunning.pl +++ b/clearadm/processrunning.pl @@ -64,7 +64,7 @@ use Utils; my $VERSION = '$Revision: 1.2 $'; ($VERSION) = ($VERSION =~ /\$Revision: (.*) /); -sub restart ($) { +sub restart($) { my ($restart) = @_; my ($status, @output) = Execute "$restart 2>&1"; @@ -72,11 +72,11 @@ sub restart ($) { 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; @@ -122,19 +122,15 @@ unless ($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"; diff --git a/clearadm/readme.cgi b/clearadm/readme.cgi index 9a259a3..ce994af 100755 --- a/clearadm/readme.cgi +++ b/clearadm/readme.cgi @@ -40,7 +40,7 @@ use warnings; 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"; @@ -50,7 +50,7 @@ use Display; use Utils; # Main -GetOptions ( +GetOptions( 'usage' => sub { Usage }, 'verbose' => sub { set_verbose }, 'debug' => sub { set_debug }, @@ -65,8 +65,7 @@ display '
';
 
 display h1 {class => 'center'}, "$ClearadmWeb::APPNAME: README";
 
-display $_
-  foreach (ReadFile 'README');
+display $_ foreach (ReadFile 'README');
 
 display '
'; diff --git a/clearadm/setup.pl b/clearadm/setup.pl index 98a0094..094f8ad 100755 --- a/clearadm/setup.pl +++ b/clearadm/setup.pl @@ -73,7 +73,7 @@ use Utils; my $VERSION = '$Revision: 1.1 $'; ($VERSION) = ($VERSION =~ /\$Revision: (.*) /); -sub SetupAgent () { +sub SetupAgent() { verbose 'Setting up Agent...'; my ($status, @output, $cmd); @@ -121,8 +121,7 @@ sub SetupAgent () { ($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}/$_"; @@ -137,8 +136,7 @@ sub SetupAgent () { # 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"; @@ -155,8 +153,7 @@ sub SetupAgent () { ($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'; @@ -164,15 +161,13 @@ sub SetupAgent () { ($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'; @@ -188,7 +183,7 @@ sub SetupAgent () { return; } # SetupAgent -sub SetupTasks () { +sub SetupTasks() { my ($status, @output, $cmd); verbose 'Setting up Tasks...'; @@ -196,16 +191,14 @@ sub SetupTasks () { # 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 @@ -213,8 +206,7 @@ sub SetupTasks () { ($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'; @@ -222,15 +214,14 @@ sub SetupTasks () { ($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); @@ -238,8 +229,7 @@ sub SetupWeb () { # 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"; @@ -266,7 +256,7 @@ sub SetupWeb () { return; } # SetupWeb -sub SetupDatabase () { +sub SetupDatabase() { verbose 'Setting up Database'; my ($status, @output, $cmd); @@ -277,8 +267,7 @@ sub SetupDatabase () { ($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'; @@ -286,8 +275,7 @@ sub SetupDatabase () { ($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'; @@ -295,8 +283,7 @@ sub SetupDatabase () { ($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'; @@ -312,15 +299,14 @@ Usage 'You must be root' 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"; diff --git a/clearadm/systems.cgi b/clearadm/systems.cgi index 1f7aba7..18419f4 100755 --- a/clearadm/systems.cgi +++ b/clearadm/systems.cgi @@ -48,7 +48,7 @@ use warnings; 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"; @@ -65,7 +65,7 @@ my $subtitle = 'Systems Status: All Systems'; my $clearadm; -sub DisplaySystems () { +sub DisplaySystems() { display start_table {cellspacing => 1, class => 'main'}; display start_Tr; @@ -80,7 +80,7 @@ sub DisplaySystems () { display th {class => 'labelCentered'}, 'Load Avg'; display end_Tr; - foreach ($clearadm->FindSystem) { + for ($clearadm->FindSystem) { my %system = %{$_}; $system{alias} = setField $system{alias}, 'N/A'; @@ -174,7 +174,7 @@ sub DisplaySystems () { 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}", @@ -189,16 +189,21 @@ sub DisplaySystems () { display td {class => $classRightTop}, "$load{loadavg} ", font {class => 'dim' }, "
$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; @@ -213,7 +218,7 @@ sub DisplaySystems () { } # DisplaySystems # Main -GetOptions ( +GetOptions( usage => sub { Usage }, verbose => sub { set_verbose }, debug => sub { set_debug }, diff --git a/clearadm/test.pl b/clearadm/test.pl index 3447284..f76dfdd 100755 --- a/clearadm/test.pl +++ b/clearadm/test.pl @@ -15,27 +15,27 @@ use Utils; 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, ); @@ -57,26 +57,25 @@ GetOptions ( sub DisplayRecord (%) { my (%record) = @_; - foreach (keys %record) { - if ($record{$_}) { - display "$_: $record{$_}"; - } else { - display "$_: "; - } # if - } # foreach + for (keys %record) { + if ($record{$_}) { + display "$_: $record{$_}"; + } else { + display "$_: "; + } # 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!'; @@ -85,16 +84,16 @@ sub TestSystem () { } # 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', @@ -102,16 +101,15 @@ sub TestSystem () { 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!'; @@ -120,108 +118,100 @@ sub TestPackage () { } # 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; @@ -233,8 +223,6 @@ TestView; ######################## 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; diff --git a/clearadm/updateccfs.pl b/clearadm/updateccfs.pl index ff4dd25..60b994e 100755 --- a/clearadm/updateccfs.pl +++ b/clearadm/updateccfs.pl @@ -66,12 +66,15 @@ use Clearcase::Vob; 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) = @_; @@ -91,6 +94,12 @@ sub snapshotViewStorage($$) { 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 @@ -114,12 +123,134 @@ sub snapshotVobStorage($$) { 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 }, @@ -198,7 +329,7 @@ if ($opts{vob} and $opts{vob} =~ /all/i) { } 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 @@ -209,6 +340,11 @@ if ($opts{vob} and $opts{vob} =~ /all/i) { } # if } # if +if (get_verbose) { + Stats \%total; + display_duration $startTime; +} # if + =pod =head1 CONFIGURATION AND ENVIRONMENT diff --git a/clearadm/updatefs.pl b/clearadm/updatefs.pl index 86df94c..6308e35 100755 --- a/clearadm/updatefs.pl +++ b/clearadm/updatefs.pl @@ -54,6 +54,7 @@ use warnings; use Net::Domain qw(hostname); use FindBin; use Getopt::Long; +use Convert::Base64; use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib"; @@ -72,17 +73,17 @@ my $clearexec = Clearexec->new; 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 = ( @@ -100,8 +101,8 @@ sub snapshotFS ($$) { 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 @@ -148,7 +149,7 @@ sub snapshotFS ($$) { } # snapshotFS # Main -GetOptions ( +GetOptions( 'usage' => sub { Usage }, 'verbose' => sub { set_verbose }, 'debug' => sub { set_debug }, @@ -156,8 +157,7 @@ GetOptions ( '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"; @@ -165,47 +165,67 @@ 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 diff --git a/clearadm/updatela.pl b/clearadm/updatela.pl index e9b4b38..250e06b 100755 --- a/clearadm/updatela.pl +++ b/clearadm/updatela.pl @@ -72,19 +72,18 @@ my $clearexec = Clearexec->new; 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}"; @@ -94,10 +93,9 @@ sub snapshotLoad ($) { 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 # @@ -129,12 +127,11 @@ sub snapshotLoad ($) { 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 @@ -145,49 +142,70 @@ sub snapshotLoad ($) { } # 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; diff --git a/clearadm/updatesystem.pl b/clearadm/updatesystem.pl index f5fbb06..1073a85 100755 --- a/clearadm/updatesystem.pl +++ b/clearadm/updatesystem.pl @@ -85,10 +85,9 @@ sub GetFilesystems(%) { ? '/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; @@ -114,19 +113,18 @@ sub GetFilesystems(%) { 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"; @@ -136,10 +134,9 @@ sub GatherSysInfo (;%) { # 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]; @@ -147,10 +144,9 @@ sub GatherSysInfo (;%) { $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) { @@ -164,7 +160,7 @@ sub GatherSysInfo (;%) { return %system; } # GatherSysInfo -sub AddFilesystems (%) { +sub AddFilesystems(%) { my (%system) = @_; my ($err, $msg); @@ -172,7 +168,7 @@ sub AddFilesystems (%) { for (GetFilesystems %system) { my %filesystem = %{$_}; - my %oldfilesystem = $clearadm->GetFilesystem ( + my %oldfilesystem = $clearadm->GetFilesystem( $filesystem{system}, $filesystem{filesystem} ); @@ -180,31 +176,29 @@ sub AddFilesystems (%) { 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"; @@ -214,10 +208,9 @@ sub AddSystem ($) { # 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; @@ -226,12 +219,12 @@ sub AddSystem ($) { } # 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}; @@ -240,7 +233,7 @@ sub UpdateSystem (%) { 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; @@ -255,7 +248,7 @@ sub UpdateSystem (%) { $host = hostname; $port = $Clearexec::CLEAROPTS{CLEAREXEC_PORT}; -GetOptions ( +GetOptions( 'usage' => sub { Usage }, 'verbose' => sub { set_verbose }, 'debug' => sub { set_debug }, @@ -264,12 +257,10 @@ GetOptions ( '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 @@ -283,7 +274,7 @@ if ($delete) { my $answer = ; 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"; @@ -300,18 +291,17 @@ if ($delete) { 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) { diff --git a/clearadm/viewager.cgi b/clearadm/viewager.cgi old mode 100755 new mode 100644 index 9ac1b1e..150237a --- a/clearadm/viewager.cgi +++ b/clearadm/viewager.cgi @@ -120,7 +120,7 @@ use warnings; 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; @@ -162,7 +162,7 @@ my $script = 'http://' my %total; my $nbrThreshold; # Number of views threshold - think top 10 -sub GenerateRegion ($) { +sub GenerateRegion($) { my ($region) = @_; verbose "Processing region $region"; @@ -185,7 +185,7 @@ sub GenerateRegion ($) { verbose_nolf '.'; }# if - my $view = Clearcase::View->new ($name, $region); + my $view = Clearcase::View->new($name, $region); my $gpath; @@ -207,13 +207,13 @@ sub GenerateRegion ($) { # 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); @@ -239,8 +239,6 @@ sub GenerateRegion ($) { # Compute age $age = Age ($modified_date); $ageSuffix = $age != 1 ? 'days' : 'day'; - #} else { - # $modified_date = 'Unknown'; } # if my %oldView = $clearadm->GetView($view->tag, $view->region); @@ -248,7 +246,6 @@ sub GenerateRegion ($) { my ($err, $msg); my %viewRec = ( - system => $view->shost, region => $view->region, tag => $view->tag, owner => $ownerid, @@ -264,11 +261,11 @@ sub GenerateRegion ($) { $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 @@ -282,12 +279,10 @@ sub GenerateRegion ($) { 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; @@ -347,7 +342,7 @@ $view{tag},$view{owner},$view{type},$view{modified},$view{age},$view{ageSuffix} return; } # Report -sub FormatTable ($@) { +sub FormatTable($@) { my ($style, @views) = @_; my $table; @@ -366,12 +361,12 @@ sub FormatTable ($@) { 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, @@ -528,12 +523,12 @@ sub FormatTable ($@) { # 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 = ''; + my $msg = ''; $msg .= <<"END";

You have old Clearcase Views

@@ -584,7 +579,7 @@ which will stop it from being reported as old.

Your friendly Clearcase Administrator END - mail ( + mail( to => $emailTo, # to => 'Andrew@DeFaria.com', mode => 'html', @@ -595,7 +590,7 @@ END return } # EmailUser -sub EmailUsers (@) { +sub EmailUsers(@) { my (@views) = @_; @views = sort { $$a{ownerName} cmp $$b{ownerName} } @views; @@ -606,16 +601,14 @@ sub EmailUsers (@) { 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 @@ -630,7 +623,7 @@ sub EmailUsers (@) { } # EmailUsers # Main -GetOptions ( +GetOptions( \%opts, 'usage' => sub { Usage }, 'verbose' => sub { set_verbose }, @@ -656,8 +649,6 @@ verbose "$FindBin::Script v$VERSION"; $clearadm = Clearadm->new; if ($opts{action} and $opts{action} eq 'generate') { - $opts{region} ||= 'all'; - Generate $opts{region}; Stats \%total if $opts{verbose}; } else { @@ -670,10 +661,9 @@ if ($opts{action} and $opts{action} eq 'generate') { $opts{region} ||= $Clearcase::CC->region; - my @views = $clearadm->FindView ( - 'all', - $opts{region}, + my @views = $clearadm->FindView( $opts{tag}, + $opts{region}, $opts{user} ); diff --git a/clearadm/viewdetails.cgi b/clearadm/viewdetails.cgi index 72b486b..4daff35 100755 --- a/clearadm/viewdetails.cgi +++ b/clearadm/viewdetails.cgi @@ -52,11 +52,12 @@ use warnings; 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; @@ -68,13 +69,9 @@ my %opts = Vars; 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 ($) { @@ -94,6 +91,10 @@ 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; @@ -154,36 +155,54 @@ sub DisplayTable ($) { 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; @@ -193,17 +212,15 @@ sub DisplayTable ($) { 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();', ); @@ -216,7 +233,7 @@ sub DisplayRegion { return } # DisplayRegion -sub DisplayViews ($) { +sub DisplayViews($) { my ($region) = @_; my $views = Clearcase::Views->new ($region); @@ -226,7 +243,7 @@ sub DisplayViews ($) { push @views, 'No Views'; } # unless - display start_form (action => 'viewdetails.cgi'); + display start_form(action => 'viewdetails.cgi'); display 'Region '; @@ -245,7 +262,7 @@ sub DisplayViews ($) { -onchange => 'submit();', ); - display submit ( + display submit( -value => 'Go', ); @@ -255,7 +272,7 @@ sub DisplayViews ($) { } # DisplayViews # Main -GetOptions ( +GetOptions( \%opts, 'usage' => sub { Usage }, 'verbose' => sub { set_verbose }, @@ -283,9 +300,7 @@ unless ($opts{tag}) { exit; } # unless -my $view = Clearcase::View->new ($opts{tag}, $opts{region}); - -DisplayTable $view; +DisplayTable(Clearcase::View->new($opts{tag}, $opts{region})); footing; @@ -315,6 +330,7 @@ L =begin man + Clearadm ClearadmWeb Clearcase Clearcase::View @@ -327,6 +343,7 @@ L =begin html
+Clearadm
ClearadmWeb
Clearcase
Clearcase::View
diff --git a/clearadm/viewservers.cgi b/clearadm/viewservers.cgi index f214c04..90639b0 100755 --- a/clearadm/viewservers.cgi +++ b/clearadm/viewservers.cgi @@ -51,7 +51,7 @@ use warnings; 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"; @@ -71,7 +71,7 @@ my $subtitle = 'View Servers'; my $VERSION = '$Revision: 1.9 $'; ($VERSION) = ($VERSION =~ /\$Revision: (.*) /); -sub DisplayTable (@) { +sub DisplayTable(@) { my (@viewServers) = @_; my $unknown = font {-class => 'unknown'}, 'Unknown'; @@ -98,7 +98,7 @@ sub DisplayTable (@) { my $i = 0; - foreach (@viewServers) { + for (@viewServers) { my $server = Clearcase::Server->new ($_, $opts{region}); # Data fields @@ -123,7 +123,7 @@ sub DisplayTable (@) { -class => 'data', }, $osVer; display end_Tr; - } # foreach + } # for display end_table; @@ -131,7 +131,7 @@ sub DisplayTable (@) { } # DisplayTable # Main -GetOptions ( +GetOptions( \%opts, 'usage' => sub { Usage }, 'verbose' => sub { set_verbose }, @@ -155,13 +155,13 @@ error "Unable to list all views in the region $opts{region}" . join ("\n", @outp my %viewServers; -foreach (@output) { +for (@output) { if (/Server host: (.*)/) { $viewServers{$1} = undef; } # if -} # foreach +} # for -DisplayTable sort (keys (%viewServers)); +DisplayTable sort(keys(%viewServers)); footing; diff --git a/clearadm/vobdetails.cgi b/clearadm/vobdetails.cgi index 89a38d6..0fc968e 100755 --- a/clearadm/vobdetails.cgi +++ b/clearadm/vobdetails.cgi @@ -52,11 +52,12 @@ use warnings; 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; @@ -77,7 +78,7 @@ if ($Clearcase::CC->region) { my $VERSION = '$Revision: 1.11 $'; ($VERSION) = ($VERSION =~ /\$Revision: (.*) /); -sub DisplayTable ($) { +sub DisplayTable($) { my ($vob) = @_; my $active = ($vob->active) ? 'YES' : 'NO'; @@ -91,6 +92,10 @@ sub DisplayTable ($) { -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; @@ -199,53 +204,80 @@ sub DisplayTable ($) { 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; @@ -255,21 +287,21 @@ sub DisplayTable ($) { 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', ); @@ -287,11 +319,11 @@ sub DisplayVobs($) { 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, @@ -300,13 +332,13 @@ sub DisplayVobs($) { display b ' VOB: '; - display popup_menu ( + display popup_menu( -name => 'vob', -values => \@vobs, -onchange => 'submit();', ); - display submit ( + display submit( -value => 'Go', ); @@ -316,7 +348,7 @@ sub DisplayVobs($) { } # DisplayVobs # Main -GetOptions ( +GetOptions( \%opts, 'usage' => sub { Usage }, 'verbose' => sub { set_verbose }, @@ -344,7 +376,7 @@ unless ($opts{tag}) { exit; } # unless -my $vob = Clearcase::Vob->new ($opts{tag}, $opts{region}); +my $vob = Clearcase::Vob->new($opts{tag}, $opts{region}); DisplayTable $vob; @@ -388,6 +420,7 @@ L =begin html
+Clearadm
ClearadmWeb
Clearcase
Clearcase::View
diff --git a/clearadm/vobservers.cgi b/clearadm/vobservers.cgi index 6748c9e..a50487e 100755 --- a/clearadm/vobservers.cgi +++ b/clearadm/vobservers.cgi @@ -51,7 +51,7 @@ use warnings; 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"; @@ -135,7 +135,7 @@ sub DisplayVobs($) { display end_table; } # DisplayVob -sub DisplayTable (@) { +sub DisplayTable(@) { my (@vobServers) = @_; my $unknown = font {-class => 'unknown'}, 'Unknown'; @@ -177,7 +177,7 @@ sub DisplayTable (@) { my $server; for (@vobServers) { - $server = Clearcase::Server->new ($_, $opts{region}); + $server = Clearcase::Server->new($_, $opts{region}); display start_Tr; display td { @@ -323,7 +323,7 @@ sub DisplayTable (@) { } # DisplayTable # Main -GetOptions ( +GetOptions( \%opts, 'usage' => sub { Usage }, 'verbose' => sub { set_verbose }, @@ -345,8 +345,7 @@ my ($status, @output) = $Clearcase::CC->execute ( ); 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; @@ -356,7 +355,7 @@ for (@output) { } # if } # for -DisplayTable sort (keys (%vobServers)); +DisplayTable sort(keys(%vobServers)); footing; diff --git a/lib/Clearcase/View.pm b/lib/Clearcase/View.pm index 79dea02..3405e40 100644 --- a/lib/Clearcase/View.pm +++ b/lib/Clearcase/View.pm @@ -127,7 +127,7 @@ use warnings; use Clearcase; use Display; -sub new ($;$) { +sub new($;$) { my ($class, $tag, $region) = @_; =pod @@ -170,14 +170,19 @@ Returns: =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 @@ -215,7 +220,7 @@ Returns: return $self->{accessed_by}; } # accessed_by -sub accessed_date () { +sub accessed_date() { my ($self) = @_; =pod @@ -253,7 +258,7 @@ Returns: return $self->{accessed_date}; } # accessed_date -sub access_path () { +sub access_path() { my ($self) = @_; =pod @@ -291,7 +296,7 @@ Returns: return $self->{access_path}; } # access_path -sub active () { +sub active() { my ($self) = @_; =pod @@ -329,7 +334,7 @@ Returns: return $self->{active}; } # active -sub additional_groups () { +sub additional_groups() { my ($self) = @_; =pod @@ -372,7 +377,7 @@ Returns: } # if } # additional_groups -sub created_by () { +sub created_by() { my ($self) = @_; =pod @@ -410,7 +415,7 @@ Returns: return $self->{created_by}; } # created_by -sub created_date () { +sub created_date() { my ($self) = @_; =pod @@ -448,7 +453,7 @@ Returns: return $self->{created_date}; } # created_date -sub cs_updated_by () { +sub cs_updated_by() { my ($self) = @_; =pod @@ -486,7 +491,7 @@ Returns: return $self->{cs_updated_by}; } # cs_updated_by -sub cs_updated_date () { +sub cs_updated_date() { my ($self) = @_; =pod @@ -524,7 +529,7 @@ Returns: return $self->{cs_updated_date}; } # cs_updated_date -sub dynamic () { +sub dynamic() { my ($self) = @_; =pod @@ -559,10 +564,11 @@ Returns: =cut + return unless $self->{type}; return $self->type eq 'dynamic'; } # dynamic -sub gpath () { +sub gpath() { my ($self) = @_; =pod @@ -600,7 +606,7 @@ Returns: return $self->{gpath}; } # gpath -sub group () { +sub group() { my ($self) = @_; =pod @@ -638,7 +644,7 @@ Returns: return $self->{group}; } # group -sub group_mode () { +sub group_mode() { my ($self) = @_; =pod @@ -676,7 +682,7 @@ Returns: return $self->{group_mode}; } # group_mode -sub host () { +sub host() { my ($self) = @_; =pod @@ -714,7 +720,7 @@ Returns: return $self->{host}; } # host -sub mode () { +sub mode() { my ($self) = @_; =pod @@ -752,7 +758,7 @@ Returns: return $self->{mode}; } # mode -sub modified_by () { +sub modified_by() { my ($self) = @_; =pod @@ -790,7 +796,7 @@ Returns: return $self->{modified_by}; } # modified_by -sub modified_date () { +sub modified_date() { my ($self) = @_; =pod @@ -828,7 +834,7 @@ Returns: return $self->{modified_date}; } # modified_date -sub other_mode () { +sub other_mode() { my ($self) = @_; =pod @@ -866,7 +872,7 @@ Returns: return $self->{other_mode}; } # other_mode -sub owner () { +sub owner() { my ($self) = @_; =pod @@ -904,7 +910,7 @@ Returns: return $self->{owner} } # owner -sub owner_mode () { +sub owner_mode() { my ($self) = @_; =pod @@ -942,7 +948,7 @@ Returns: return $self->{owner_mode} } # owner_mode -sub properties () { +sub properties() { my ($self) = @_; =pod @@ -980,7 +986,7 @@ Returns: return $self->{properties}; } # properties -sub region () { +sub region() { my ($self) = @_; =pod @@ -1018,7 +1024,7 @@ Returns: return $self->{region}; } # region -sub shost () { +sub shost() { my ($self) = @_; =pod @@ -1056,7 +1062,7 @@ Returns: return $self->{shost}; } # shost -sub snapshot () { +sub snapshot() { my ($self) = @_; =pod @@ -1091,10 +1097,11 @@ Returns: =cut + return unless $self->{type}; return $self->type eq 'snapshot'; } # snapshot -sub webview () { +sub webview() { my ($self) = @_; =pod @@ -1129,10 +1136,11 @@ Returns: =cut - return $self->type eq 'webview'; + return unless $self->{type}; + return $self->{type} eq 'webview'; } # webview -sub tag () { +sub tag() { my ($self) = @_; =pod @@ -1170,7 +1178,7 @@ Returns: return $self->{tag}; } # tag -sub text_mode () { +sub text_mode() { my ($self) = @_; =pod @@ -1208,7 +1216,7 @@ Returns: return $self->{text_mode}; } # tag -sub type () { +sub type() { my ($self) = @_; =pod @@ -1243,10 +1251,10 @@ Returns: =cut - return $self->{type} ? $self->{type} : 'Unknown'; + return $self->{type}; } # type -sub ucm () { +sub ucm() { my ($self) = @_; =pod @@ -1284,7 +1292,7 @@ Returns: return $self->{ucm}; } # ucm -sub uuid () { +sub uuid() { my ($self) = @_; =pod @@ -1322,7 +1330,7 @@ Returns: return $self->{uuid}; } # uuid -sub exists () { +sub exists() { my ($self) = @_; =pod @@ -1357,12 +1365,12 @@ Returns: =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 @@ -1412,7 +1420,7 @@ Ouput from cleartool $region ||= $Clearcase::CC->region; if ($self->exists) { - $self->updateViewInfo ($region); + $self->updateViewInfo; return (0, ()) } # if @@ -1421,21 +1429,21 @@ Ouput from cleartool 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 @@ -1493,18 +1501,18 @@ Array of output # 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 @@ -1551,12 +1559,12 @@ Ouput from cleartool 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 @@ -1564,7 +1572,7 @@ Ouput from cleartool return ($status, @output); } # remove -sub start () { +sub start() { my ($self) = @_; =pod @@ -1605,10 +1613,10 @@ Ouput from cleartool =cut - return $Clearcase::CC->execute ("startview $self->{tag}"); + return $Clearcase::CC->execute("startview $self->{tag}"); } # start -sub stop () { +sub stop() { my ($self) = @_; =pod @@ -1649,10 +1657,10 @@ Ouput from cleartool =cut - return $Clearcase::CC->execute ("endview $self->{tag}"); + return $Clearcase::CC->execute("endview $self->{tag}"); } # stop -sub kill () { +sub kill() { my ($self) = @_; =pod @@ -1693,10 +1701,10 @@ Ouput from cleartool =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 @@ -1744,15 +1752,15 @@ Ouput from cleartool 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... @@ -2167,7 +2175,7 @@ Returns: sub updateViewSpace() { my ($self) = @_; - my ($status, @output) = $Clearcase::CC->execute ( + my ($status, @output) = $Clearcase::CC->execute( "space -region $self->{region} -view $self->{tag}" ); diff --git a/lib/Clearcase/Vob.pm b/lib/Clearcase/Vob.pm index 596fafb..f8c636b 100644 --- a/lib/Clearcase/Vob.pm +++ b/lib/Clearcase/Vob.pm @@ -98,8 +98,8 @@ use warnings; use Clearcase; use OSDep; -sub new ($) { - my ($class, $tag) = @_; +sub new($;$) { + my ($class, $tag, $region) = @_; =pod @@ -141,8 +141,11 @@ Returns: =cut + $region ||= $Clearcase::CC->region; + $class = bless { - tag => $tag + tag => $tag, + region => $region, }, $class; $class->updateVobInfo; @@ -150,7 +153,7 @@ Returns: return $class; } # new -sub tag () { +sub tag() { my ($self) = @_; =pod @@ -188,7 +191,7 @@ Returns: return $self->{tag}; } # tag -sub gpath () { +sub gpath() { my ($self) = @_; =pod @@ -226,7 +229,7 @@ Returns: return $self->{gpath}; } # gpath -sub shost () { +sub shost() { my ($self) = @_; =pod @@ -268,7 +271,8 @@ Returns: sub name() { goto &tag; } # name -sub access () { + +sub access() { my ($self) = @_; =pod @@ -308,7 +312,7 @@ Returns either public for public VOBs or private for private VOBs return $self->{access}; } # access -sub mopts () { +sub mopts() { my ($self) = @_; =pod @@ -346,7 +350,7 @@ Returns: return $self->{mopts}; } # mopts -sub region () { +sub region() { my ($self) = @_; =pod @@ -384,7 +388,7 @@ Returns: return $self->{region}; } # region -sub active () { +sub active() { my ($self) = @_; =pod @@ -423,7 +427,7 @@ Returns: return $self->{active}; } # active -sub replica_uuid () { +sub replica_uuid() { my ($self) = @_; =pod @@ -461,7 +465,7 @@ Returns: return $self->{replica_uuid}; } # replica_uuid -sub host () { +sub host() { my ($self) = @_; =pod @@ -499,7 +503,7 @@ Returns: return $self->{host}; } # host -sub access_path () { +sub access_path() { my ($self) = @_; =pod @@ -539,7 +543,7 @@ This is the path relative to the VOB's host return $self->{access_path}; } # access_path -sub family_uuid () { +sub family_uuid() { my ($self) = @_; =pod @@ -577,7 +581,7 @@ Returns: return $self->{family_uuid}; } # family_uuid -sub vob_registry_attributes () { +sub vob_registry_attributes() { my ($self) = @_; =pod @@ -615,7 +619,7 @@ Returns: 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}"); @@ -647,10 +651,10 @@ sub expand_space () { 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+)\)/) { @@ -1353,7 +1357,7 @@ Returns: return %{$self->{hyperlinks}}; } # hyperlinks -sub countdb () { +sub countdb() { my ($self) = @_; # Set values to zero in case we cannot get the right values from countdb @@ -1367,13 +1371,13 @@ sub 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; @@ -1393,7 +1397,7 @@ sub countdb () { return; } # countdb -sub elements () { +sub elements() { my ($self) = @_; =pod @@ -1433,7 +1437,7 @@ Returns: return $self->{elements}; } # elements -sub branches () { +sub branches() { my ($self) = @_; =pod @@ -1473,7 +1477,7 @@ Returns: return $self->{branches}; } # branches -sub versions () { +sub versions() { my ($self) = @_; =pod @@ -1513,7 +1517,7 @@ Returns: return $self->{versions}; } # versions -sub dbsize () { +sub dbsize() { my ($self) = @_; =pod @@ -1553,7 +1557,7 @@ Returns: return $self->{dbsize}; } # dbsize -sub admsize () { +sub admsize() { my ($self) = @_; =pod @@ -1593,7 +1597,7 @@ Returns: return $self->{admsize}; } # admsize -sub ctsize () { +sub ctsize() { my ($self) = @_; =pod @@ -1633,7 +1637,7 @@ Returns: return $self->{ctsize}; } # ctsize -sub dosize () { +sub dosize() { my ($self) = @_; =pod @@ -1673,7 +1677,7 @@ Returns: return $self->{dosize}; } # dosize -sub srcsize () { +sub srcsize() { my ($self) = @_; =pod @@ -1713,7 +1717,7 @@ Returns: return $self->{srcsize}; } # srcsize -sub size () { +sub size() { my ($self) = @_; =pod @@ -1753,7 +1757,7 @@ Returns: return $self->{size}; } # size -sub mount () { +sub mount() { my ($self) = @_; =pod @@ -1796,12 +1800,12 @@ An array of lines output from the cleartool mount command 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 @@ -1842,12 +1846,12 @@ Ouput from cleartool =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 @@ -1882,12 +1886,12 @@ Returns: =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 @@ -1956,14 +1960,14 @@ Ouput from cleartool 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; @@ -1971,7 +1975,7 @@ Ouput from cleartool return ($status, @output); } # create -sub remove () { +sub remove() { my ($self) = @_; =pod @@ -2012,13 +2016,13 @@ Ouput from cleartool =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... diff --git a/lib/DateUtils.pm b/lib/DateUtils.pm index 40a581e..6c8164f 100644 --- a/lib/DateUtils.pm +++ b/lib/DateUtils.pm @@ -102,11 +102,11 @@ my $SECS_IN_HOUR = $SECS_IN_MIN * 60; 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; @@ -121,7 +121,7 @@ sub ymdhms(;$) { $wday, $yday, $isdst - ) = localtime($time); + ) = localtime ($time); # Adjust month $mon++; @@ -139,7 +139,7 @@ sub ymdhms(;$) { return $year, $mon, $mday, $hour, $min, $sec; } # ymdhms -sub julian($$$) { +sub julian ($$$) { my ($year, $month, $day) = @_; my $days = 0; @@ -154,19 +154,19 @@ sub julian($$$) { 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) @@ -192,7 +192,7 @@ Hash of parms. Acceptable values are of the following format: 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 @@ -223,47 +223,47 @@ Returns: '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 @@ -312,13 +312,13 @@ Returns: 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 @@ -327,9 +327,9 @@ Returns: } # if } # Age -sub Compare($$) { +sub Compare ($$) { my ($date1, $date2) = @_; - + =pod =head2 Compare ($date2, $date2) @@ -372,9 +372,9 @@ Returns: return DateToEpoch ($date1) <=> DateToEpoch ($date2); } # Compare -sub DateToEpoch($) { +sub DateToEpoch ($) { my ($date) = @_; - + =pod =head2 DateToEpoch ($datetime) @@ -415,13 +415,13 @@ Returns: 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, @@ -436,23 +436,23 @@ Returns: 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) @@ -491,19 +491,19 @@ Returns: 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; @@ -541,24 +541,24 @@ Returns: $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) @@ -594,10 +594,10 @@ Returns: =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++; @@ -606,13 +606,13 @@ Returns: $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/; @@ -626,7 +626,7 @@ sub UTC2Localtime($) { ); } # UTC2Localtime -sub FormatDate($) { +sub FormatDate ($) { my ($date) = @_; =pod @@ -670,7 +670,7 @@ Returns: . substr ($date, 0, 4); } # FormatDate -sub FormatTime($) { +sub FormatTime ($) { my ($time) = @_; =pod @@ -712,13 +712,13 @@ Returns: 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 @@ -760,7 +760,7 @@ Returns: return "$mon/$mday/$year"; } # MDY -sub SQLDatetime2UnixDatetime($) { +sub SQLDatetime2UnixDatetime ($) { my ($sqldatetime) = @_; =pod @@ -815,12 +815,12 @@ Returns: 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 @@ -914,7 +914,7 @@ Returns: return $year . "-" . $month . "-" . $days . substr $timestamp, 10; } # SubtractDays -sub Today2SQLDatetime() { +sub Today2SQLDatetime () { =pod @@ -951,7 +951,7 @@ Returns: return UnixDatetime2SQLDatetime (scalar (localtime)); } # Today2SQLDatetime -sub UnixDatetime2SQLDatetime($) { +sub UnixDatetime2SQLDatetime ($) { my ($datetime) = @_; =pod @@ -1060,7 +1060,7 @@ Returns: unless ($months{$month_name}) { $month_name = substr $datetime, 8, 3; } # unless - + my $month = $months{$month_name}; my $time = substr $datetime, 11, 8; @@ -1072,12 +1072,12 @@ Returns: 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; @@ -1091,7 +1091,7 @@ Returns: return "$year-$month-$day $time"; } # UnixDatetime2SQLDatetime -sub YMD(;$) { +sub YMD (;$) { my ($time) = @_; =pod @@ -1133,7 +1133,7 @@ Returns: return "$year$mon$mday"; } # YMD -sub YMDHM(;$) { +sub YMDHM (;$) { my ($time) = @_; =pod @@ -1175,7 +1175,7 @@ Returns: return "$year$mon$mday\@$hour:$min"; } # YMDHM -sub YMDHMS(;$) { +sub YMDHMS (;$) { my ($time) = @_; =pod @@ -1217,7 +1217,7 @@ Returns: return "$year$mon$mday\@$hour:$min:$sec"; } # YMDHMS -sub timestamp(;$) { +sub timestamp (;$) { my ($time) = @_; =pod @@ -1257,72 +1257,6 @@ Returns: 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 -- 2.17.1