--- /dev/null
+#!/bin/bash
+
+path=$1
+
+if [ -z "$path" ]; then
+ echo "Usage $0 <path>"
+ exit 1
+fi
+
+IFS='/' read -ra components <<< "$path"
+
+testpath=''
+
+for component in "${components[@]}"; do
+ [ -z "$component" ] && continue
+
+ testpath="${testpath}/$component"
+
+ if [ -h "$testpath" ]; then
+ echo "$testpath: symbolic link to $(ls -l $testpath | awk '{print $NF}')"
+ testpath=$(readlink -n $testpath)
+ fi
+done
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/bin/env perl
=pod
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/bin/env perl
=pod
use Getopt::Long;
use FindBin;
+use Sys::Hostname;
use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib";
$clearexec->setMultithreaded ($multithreaded);
-my $logfile = "$Clearexec::CLEAROPTS{CLEAREXEC_LOGDIR}/$FindBin::Script.log";
+my $logfile = "$Clearexec::CLEAROPTS{CLEAREXEC_LOGDIR}/$FindBin::Script";
+ $logfile =~ s/\.pl$//;
+ $logfile .= '.' . hostname() . '.log';
EnterDaemonMode $logfile, $logfile, $pidfile
if $daemon;
-#!/usr/bin/perl
+#!/usr/bin/env perl
=pod
-#!/usr/bin/perl
+#!/usr/bin/env perl
=pod
Examine the Clearadm schedule and perform the tasks required.
+Note that sending the Cleartasks.pl process a sigusr1 will cause it to toggle
+verbose mode.
+
=cut
use strict;
use FindBin;
use Getopt::Long;
+use Sys::Hostname;
use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib";
my $VERSION = '$Revision: 1.25 $';
($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
-my $logfile = "$Clearadm::CLEAROPTS{CLEARADM_LOGDIR}/$FindBin::Script.log";
+my $logfile = "$Clearadm::CLEAROPTS{CLEARADM_LOGDIR}/$FindBin::Script";
+ $logfile =~ s/\.pl$//;
+ $logfile .= '.' . hostname() . '.log';
+
my $pidfile = "$Clearadm::CLEAROPTS{CLEARADM_RUNDIR}/$FindBin::Script.pid";
my $daemon = 1;
my ($clearadm, $clearexec);
+sub ToggleVerbose() {
+ if (get_verbose) {
+ display 'Turning verbose off';
+ set_verbose 0;
+ } else {
+ display 'Turning verbose on';
+ set_verbose 1;
+ } # if
+} # ToggleVerbose
+
+$SIG{USR1} = \&ToggleVerbose;
+
sub HandleSystemNotCheckingIn (%) {
my (%system) = @_;
} # HandleSystemNotCheckingIn
sub SystemsCheckin () {
- foreach ($clearadm->FindSystem) {
+ for ($clearadm->FindSystem) {
my %system = %$_;
next if $system{active} eq 'false';
$clearadm->ClearNotifications ($system{name})
if $system{notification} and $system{notification} eq 'Heartbeat';
- } # foreach
+ } # for
return;
} # SystemsCheckin
my $when = Today2SQLDatetime;
- foreach (@output) {
+ for (@output) {
# We need to log this output. Write it to STDOUT
display $_;
undef,
$lastid,
);
- } # foreach
+ } # for
return;
} # ProcessLoadAvgErrors
my %system;
- foreach (@output) {
+ for (@output) {
# We need to log this output. Write it to STDOUT
display $_;
$system{$1} = \%fsinfo;
} # if
} # if
- } # foreach
+ } # for
- foreach my $systemName (keys %system) {
+ for my $systemName (keys %system) {
my @fsinfo;
if (ref $system{$systemName} eq 'HASH') {
<ul>
END
- foreach (@fsinfo) {
+ for (@fsinfo) {
my %fsinfo = %{$_};
my $filesystemLink = $Clearadm::CLEAROPTS{CLEARADM_WEBBASE};
$filesystemLink .= "/plot.cgi?type=filesystem&system=$systemName";
$message .= "<li>Filesystem <a href=\"$filesystemLink\">";
$message .= "$fsinfo{filesystem}</a> is $fsinfo{usedPct}% full. Threshold is ";
$message .= "$fsinfo{threshold}%</li>";
- } # foreach
+ } # for
$message .= "</ul>";
undef,
$lastid,
);
- } # foreach
+ } # for
return;
} # ProcessFilesystemErrors
my ($sleep, @workItems) = $clearadm->GetWork;
- foreach (@workItems) {
+ for (@workItems) {
my %scheduledTask = %{$_};
$scheduledTask{system} ||= 'All systems';
if ($scheduledTask{system} =~ /all systems/i) {
- foreach my $system ($clearadm->FindSystem) {
+ for my $system ($clearadm->FindSystem) {
+ next if $$system{active} eq 'false';
+
$scheduledTask{system} = $$system{name};
$sleep = ExecuteTask $sleep, %scheduledTask;
- } # foreach
+ } # for
} else {
$sleep = ExecuteTask $sleep, %scheduledTask;
} # if
- } # foreach
+ } # for
if ($sleep > 0) {
verbose "Sleeping for $sleep seconds";
sleep $sleep;
} # if
-} # foreach
+} # for
=pod
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/bin/env perl
=pod
-broadcastA|ddr <ip>: Broadcast IP (Default: Current subnet)
-broadcastT|ime <seconds>: Number of sends to wait for responses to broadcast
- (Default: 30 seconds)
+ (Default: 10 seconds)
=head1 DESCRIPTION
use Clearadm;
use Display;
+use OSDep;
use Utils;
my $VERSION = '$Revision: 1.1 $';
verbose "Performing discovery (for $broadcastTime seconds)...";
while (<$broadcast>) {
- if (/from (.*):/) {
- my $ip = $1;
- my $hostname = gethostbyaddr (inet_aton ($ip), AF_INET);
-
- unless ($hosts{$ip}) {
- verbose "Received response from ($ip): $hostname";
- $hosts{$ip} = $hostname;
- } # unless
+ display "Received line: $_";
+ if (/from (\S+) \((.+)\)/) {
+ my $hostname = $1;
+ my $ip = $2;
+
+ # Remove domain
+ $hostname =~ s/(\w+)\..*/$1/;
+
+ unless ($hosts{$ip}) {
+ verbose "Received response from ($ip): $hostname";
+ $hosts{$ip} = $hostname;
+ } # unless
} # if
last
# Announce ourselves
verbose "$FindBin::Script V$VERSION";
-my $broadcastCmd = "ping -b $broadcastAddress 2>&1";
+my $broadcastCmd = 'ping ';
+if ($ARCHITECTURE eq 'solaris') {
+ $broadcastCmd .= '-s ';
+} else {
+ $broadcastCmd .= '-b ';
+} # if
+
+$broadcastCmd .= "$broadcastAddress 2>&1";
+
my $pid = open my $broadcast, '-|', $broadcastCmd
or error "Unable to do $broadcastCmd", 1;
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
#
###############################################################################
Alias /clearadm /opt/clearscm/clearadm
+
+DirectoryIndex index.cgi index.html
<Directory "/opt/clearscm/clearadm">
Options Indexes FollowSymLinks ExecCGI
Order allow,deny
Allow from all
Require all granted
- DirectoryIndex index.cgi index.html
</Directory>
AddHandler cgi-script .cgi
+++ /dev/null
-#!/bin/sh
-### BEGIN INIT INFO
-# Provides: clearagent
-# Required-Start: $network
-# Required-Stop: none
-# Default-Start: 2 3 4 5
-# Default-Stop: 0 1 6
-# Short-Description: Starts the clearagent daemon
-# Description: Clearagent is part of the Clearadm package by ClearSCM,
-# Inc. It is a daemon that runs in the background and
-# responds to requests to run commands on the local system
-# and return the results.
-### END INIT INFO
-
-# Author: Andrew DeFaria <Andrew@ClearSCM.com>
-#
-# Do NOT "set -e"
-
-# PATH should only include /usr/* if it runs after the mountnfs.sh script
-PATH=/sbin:/usr/sbin:/bin:/usr/bin
-DESC="Clearagent Daemon"
-NAME=clearagent.pl
-DAEMON=/opt/clearscm/clearadm/$NAME
-PIDFILE=/opt/clearscm/clearadm/var/run/$NAME.pid
-DAEMON_ARGS=""
-SCRIPTNAME=/etc/init.d/$NAME
-RUNASUSER="clearagent"
-
-# Exit if the package is not installed
-[ -x "$DAEMON" ] || exit 0
-
-# Read configuration variable file if it is present
-[ -r /etc/default/$NAME ] && . /etc/default/$NAME
-
-# Load the VERBOSE setting and other rcs variables
-. /lib/init/vars.sh
-
-# Define LSB log_* functions.
-# Depend on lsb-base (>= 3.0-6) to ensure that this file is present.
-. /lib/lsb/init-functions
-
-#
-# Function that starts the daemon/service
-#
-do_start()
-{
- # Return
- # 0 if daemon has been started
- # 1 if daemon was already running
- # 2 if daemon could not be started
- start-stop-daemon --start --quiet --pidfile $PIDFILE --exec $DAEMON --test > /dev/null \
- || return 1
- start-stop-daemon --start --quiet --pidfile $PIDFILE --exec $DAEMON \
- --chuid $RUNASUSER \
- -- $DAEMON_ARGS \
- || return 2
-}
-
-#
-# Function that stops the daemon/service
-#
-do_stop()
-{
- # Return
- # 0 if daemon has been stopped
- # 1 if daemon was already stopped
- # 2 if daemon could not be stopped
- # other if a failure occurred
- start-stop-daemon --stop --quiet --retry=TERM/30/KILL/5 --pidfile $PIDFILE --name $NAME
- RETVAL="$?"
- [ "$RETVAL" = 2 ] && return 2
- # Wait for children to finish too if this is a daemon that forks
- # and if the daemon is only ever run from this initscript.
- # If the above conditions are not satisfied then add some other code
- # that waits for the process to drop all resources that could be
- # needed by services started subsequently. A last resort is to
- # sleep for some time.
- start-stop-daemon --stop --quiet --oknodo --retry=0/30/KILL/5 --exec $DAEMON
- [ "$?" = 2 ] && return 2
- # Many daemons don't delete their pidfiles when they exit.
- rm -f $PIDFILE
- return "$RETVAL"
-}
-
-#
-# Function that sends a SIGHUP to the daemon/service
-#
-do_reload() {
- #
- # If the daemon can reload its configuration without
- # restarting (for example, when it is sent a SIGHUP),
- # then implement that here.
- #
- start-stop-daemon --stop --signal 1 --quiet --pidfile $PIDFILE --name $NAME
- return 0
-}
-
-case "$1" in
- start)
- [ "$VERBOSE" != no ] && log_daemon_msg "Starting $DESC" "$NAME"
- do_start
- case "$?" in
- 0|1) [ "$VERBOSE" != no ] && log_end_msg 0 ;;
- 2) [ "$VERBOSE" != no ] && log_end_msg 1 ;;
- esac
- ;;
- stop)
- [ "$VERBOSE" != no ] && log_daemon_msg "Stopping $DESC" "$NAME"
- do_stop
- case "$?" in
- 0|1) [ "$VERBOSE" != no ] && log_end_msg 0 ;;
- 2) [ "$VERBOSE" != no ] && log_end_msg 1 ;;
- esac
- ;;
- status)
- status_of_proc "$DAEMON" "$NAME" && exit 0 || exit $?
- ;;
- #reload|force-reload)
- #
- # If do_reload() is not implemented then leave this commented out
- # and leave 'force-reload' as an alias for 'restart'.
- #
- #log_daemon_msg "Reloading $DESC" "$NAME"
- #do_reload
- #log_end_msg $?
- #;;
- restart|force-reload)
- #
- # If the "reload" option is implemented then remove the
- # 'force-reload' alias
- #
- log_daemon_msg "Restarting $DESC" "$NAME"
- do_stop
- case "$?" in
- 0|1)
- do_start
- case "$?" in
- 0) log_end_msg 0 ;;
- 1) log_end_msg 1 ;; # Old process is still running
- *) log_end_msg 1 ;; # Failed to start
- esac
- ;;
- *)
- # Failed to stop
- log_end_msg 1
- ;;
- esac
- ;;
- *)
- #echo "Usage: $SCRIPTNAME {start|stop|restart|reload|force-reload}" >&2
- echo "Usage: $SCRIPTNAME {start|stop|status|restart|force-reload}" >&2
- exit 3
- ;;
-esac
-
-:
--- /dev/null
+clearagent.solaris
\ No newline at end of file
--- /dev/null
+#!/bin/sh
+### BEGIN INIT INFO
+# Provides: clearagent
+# Required-Start: $network
+# Required-Stop: none
+# Default-Start: 2 3 4 5
+# Default-Stop: 0 1 6
+# Short-Description: Starts the clearagent daemon
+# Description: Clearagent is part of the Clearadm package by ClearSCM,
+# Inc. It is a daemon that runs in the background and
+# responds to requests to run commands on the local system
+# and return the results.
+### END INIT INFO
+
+# Author: Andrew DeFaria <Andrew@ClearSCM.com>
+#
+# Do NOT "set -e"
+
+# PATH should only include /usr/* if it runs after the mountnfs.sh script
+PATH=/sbin:/usr/sbin:/bin:/usr/bin
+DESC="Clearagent Daemon"
+NAME=clearagent.pl
+DAEMON=/opt/clearscm/clearadm/$NAME
+PIDFILE=/opt/clearscm/clearadm/var/run/$NAME.pid
+DAEMON_ARGS=""
+SCRIPTNAME=/etc/init.d/$NAME
+RUNASUSER="clearagent"
+
+# Exit if the package is not installed
+[ -x "$DAEMON" ] || exit 0
+
+# Read configuration variable file if it is present
+[ -r /etc/default/$NAME ] && . /etc/default/$NAME
+
+# Load the VERBOSE setting and other rcs variables
+. /lib/init/vars.sh
+
+# Define LSB log_* functions.
+# Depend on lsb-base (>= 3.0-6) to ensure that this file is present.
+. /lib/lsb/init-functions
+
+#
+# Function that starts the daemon/service
+#
+do_start()
+{
+ # Return
+ # 0 if daemon has been started
+ # 1 if daemon was already running
+ # 2 if daemon could not be started
+ start-stop-daemon --start --quiet --pidfile $PIDFILE --exec $DAEMON --test > /dev/null \
+ || return 1
+ start-stop-daemon --start --quiet --pidfile $PIDFILE --exec $DAEMON \
+ --chuid $RUNASUSER \
+ -- $DAEMON_ARGS \
+ || return 2
+}
+
+#
+# Function that stops the daemon/service
+#
+do_stop()
+{
+ # Return
+ # 0 if daemon has been stopped
+ # 1 if daemon was already stopped
+ # 2 if daemon could not be stopped
+ # other if a failure occurred
+ start-stop-daemon --stop --quiet --retry=TERM/30/KILL/5 --pidfile $PIDFILE --name $NAME
+ RETVAL="$?"
+ [ "$RETVAL" = 2 ] && return 2
+ # Wait for children to finish too if this is a daemon that forks
+ # and if the daemon is only ever run from this initscript.
+ # If the above conditions are not satisfied then add some other code
+ # that waits for the process to drop all resources that could be
+ # needed by services started subsequently. A last resort is to
+ # sleep for some time.
+ start-stop-daemon --stop --quiet --oknodo --retry=0/30/KILL/5 --exec $DAEMON
+ [ "$?" = 2 ] && return 2
+ # Many daemons don't delete their pidfiles when they exit.
+ rm -f $PIDFILE
+ return "$RETVAL"
+}
+
+#
+# Function that sends a SIGHUP to the daemon/service
+#
+do_reload() {
+ #
+ # If the daemon can reload its configuration without
+ # restarting (for example, when it is sent a SIGHUP),
+ # then implement that here.
+ #
+ start-stop-daemon --stop --signal 1 --quiet --pidfile $PIDFILE --name $NAME
+ return 0
+}
+
+case "$1" in
+ start)
+ [ "$VERBOSE" != no ] && log_daemon_msg "Starting $DESC" "$NAME"
+ do_start
+ case "$?" in
+ 0|1) [ "$VERBOSE" != no ] && log_end_msg 0 ;;
+ 2) [ "$VERBOSE" != no ] && log_end_msg 1 ;;
+ esac
+ ;;
+ stop)
+ [ "$VERBOSE" != no ] && log_daemon_msg "Stopping $DESC" "$NAME"
+ do_stop
+ case "$?" in
+ 0|1) [ "$VERBOSE" != no ] && log_end_msg 0 ;;
+ 2) [ "$VERBOSE" != no ] && log_end_msg 1 ;;
+ esac
+ ;;
+ status)
+ status_of_proc "$DAEMON" "$NAME" && exit 0 || exit $?
+ ;;
+ #reload|force-reload)
+ #
+ # If do_reload() is not implemented then leave this commented out
+ # and leave 'force-reload' as an alias for 'restart'.
+ #
+ #log_daemon_msg "Reloading $DESC" "$NAME"
+ #do_reload
+ #log_end_msg $?
+ #;;
+ restart|force-reload)
+ #
+ # If the "reload" option is implemented then remove the
+ # 'force-reload' alias
+ #
+ log_daemon_msg "Restarting $DESC" "$NAME"
+ do_stop
+ case "$?" in
+ 0|1)
+ do_start
+ case "$?" in
+ 0) log_end_msg 0 ;;
+ 1) log_end_msg 1 ;; # Old process is still running
+ *) log_end_msg 1 ;; # Failed to start
+ esac
+ ;;
+ *)
+ # Failed to stop
+ log_end_msg 1
+ ;;
+ esac
+ ;;
+ *)
+ #echo "Usage: $SCRIPTNAME {start|stop|restart|reload|force-reload}" >&2
+ echo "Usage: $SCRIPTNAME {start|stop|status|restart|force-reload}" >&2
+ exit 3
+ ;;
+esac
+
+:
--- /dev/null
+#/bin/bash
+#
+# Solaris doesn't support init.d scripts and I'm not writting a bona fide
+# SMF service for this
+exec /opt/clearscm/clearadm/clearagent.pl
+++ /dev/null
-#!/bin/sh
-### BEGIN INIT INFO
-# Provides: cleartasks
-# Required-Start: $network $mysql
-# Required-Stop: none
-# Default-Start: 2 3 4 5
-# Default-Stop: 0 1 6
-# Short-Description: Starts the cleartasks daemon
-# Description: Cleartasks are part of the Clearadm package by ClearSCM,
-# Inc. It is a daemon that runs in the background and
-# performs the various predefined and user defined tasks
-# from the Clearadm database
-### END INIT INFO
-
-# Author: Andrew DeFaria <Andrew@ClearSCM.com>
-#
-# Do NOT "set -e"
-
-# PATH should only include /usr/* if it runs after the mountnfs.sh script
-PATH=/sbin:/usr/sbin:/bin:/usr/bin
-DESC="Cleartasks Daemon"
-NAME=cleartasks.pl
-DAEMON=/opt/clearscm/clearadm/$NAME
-PIDFILE=/opt/clearscm/clearadm/var/run/$NAME.pid
-DAEMON_ARGS=""
-SCRIPTNAME=/etc/init.d/$NAME
-RUNASUSER="clearagent"
-
-# Exit if the package is not installed
-[ -x "$DAEMON" ] || exit 0
-
-# Read configuration variable file if it is present
-[ -r /etc/default/$NAME ] && . /etc/default/$NAME
-
-# Load the VERBOSE setting and other rcs variables
-. /lib/init/vars.sh
-
-# Define LSB log_* functions.
-# Depend on lsb-base (>= 3.0-6) to ensure that this file is present.
-. /lib/lsb/init-functions
-
-#
-# Function that starts the daemon/service
-#
-do_start()
-{
- # Return
- # 0 if daemon has been started
- # 1 if daemon was already running
- # 2 if daemon could not be started
- start-stop-daemon --start --quiet --pidfile $PIDFILE --exec $DAEMON --test > /dev/null \
- || return 1
- start-stop-daemon --start --quiet --pidfile $PIDFILE --exec $DAEMON \
- --chuid $RUNASUSER \
- -- $DAEMON_ARGS \
- || return 2
-}
-
-#
-# Function that stops the daemon/service
-#
-do_stop()
-{
- # Return
- # 0 if daemon has been stopped
- # 1 if daemon was already stopped
- # 2 if daemon could not be stopped
- # other if a failure occurred
- start-stop-daemon --stop --quiet --retry=TERM/30/KILL/5 --pidfile $PIDFILE --name $NAME
- RETVAL="$?"
- [ "$RETVAL" = 2 ] && return 2
- # Wait for children to finish too if this is a daemon that forks
- # and if the daemon is only ever run from this initscript.
- # If the above conditions are not satisfied then add some other code
- # that waits for the process to drop all resources that could be
- # needed by services started subsequently. A last resort is to
- # sleep for some time.
- start-stop-daemon --stop --quiet --oknodo --retry=0/30/KILL/5 --exec $DAEMON
- [ "$?" = 2 ] && return 2
- # Many daemons don't delete their pidfiles when they exit.
- rm -f $PIDFILE
- return "$RETVAL"
-}
-
-#
-# Function that sends a SIGHUP to the daemon/service
-#
-do_reload() {
- #
- # If the daemon can reload its configuration without
- # restarting (for example, when it is sent a SIGHUP),
- # then implement that here.
- #
- start-stop-daemon --stop --signal 1 --quiet --pidfile $PIDFILE --name $NAME
- return 0
-}
-
-case "$1" in
- start)
- [ "$VERBOSE" != no ] && log_daemon_msg "Starting $DESC" "$NAME"
- do_start
- case "$?" in
- 0|1) [ "$VERBOSE" != no ] && log_end_msg 0 ;;
- 2) [ "$VERBOSE" != no ] && log_end_msg 1 ;;
- esac
- ;;
- stop)
- [ "$VERBOSE" != no ] && log_daemon_msg "Stopping $DESC" "$NAME"
- do_stop
- case "$?" in
- 0|1) [ "$VERBOSE" != no ] && log_end_msg 0 ;;
- 2) [ "$VERBOSE" != no ] && log_end_msg 1 ;;
- esac
- ;;
- status)
- status_of_proc "$DAEMON" "$NAME" && exit 0 || exit $?
- ;;
- #reload|force-reload)
- #
- # If do_reload() is not implemented then leave this commented out
- # and leave 'force-reload' as an alias for 'restart'.
- #
- #log_daemon_msg "Reloading $DESC" "$NAME"
- #do_reload
- #log_end_msg $?
- #;;
- restart|force-reload)
- #
- # If the "reload" option is implemented then remove the
- # 'force-reload' alias
- #
- log_daemon_msg "Restarting $DESC" "$NAME"
- do_stop
- case "$?" in
- 0|1)
- do_start
- case "$?" in
- 0) log_end_msg 0 ;;
- 1) log_end_msg 1 ;; # Old process is still running
- *) log_end_msg 1 ;; # Failed to start
- esac
- ;;
- *)
- # Failed to stop
- log_end_msg 1
- ;;
- esac
- ;;
- *)
- #echo "Usage: $SCRIPTNAME {start|stop|restart|reload|force-reload}" >&2
- echo "Usage: $SCRIPTNAME {start|stop|status|restart|force-reload}" >&2
- exit 3
- ;;
-esac
-
-:
--- /dev/null
+cleartasks.solaris
\ No newline at end of file
--- /dev/null
+#!/bin/sh
+### BEGIN INIT INFO
+# Provides: cleartasks
+# Required-Start: $network $mysql
+# Required-Stop: none
+# Default-Start: 2 3 4 5
+# Default-Stop: 0 1 6
+# Short-Description: Starts the cleartasks daemon
+# Description: Cleartasks are part of the Clearadm package by ClearSCM,
+# Inc. It is a daemon that runs in the background and
+# performs the various predefined and user defined tasks
+# from the Clearadm database
+### END INIT INFO
+
+# Author: Andrew DeFaria <Andrew@ClearSCM.com>
+#
+# Do NOT "set -e"
+
+# PATH should only include /usr/* if it runs after the mountnfs.sh script
+PATH=/sbin:/usr/sbin:/bin:/usr/bin
+DESC="Cleartasks Daemon"
+NAME=cleartasks.pl
+DAEMON=/opt/clearscm/clearadm/$NAME
+PIDFILE=/opt/clearscm/clearadm/var/run/$NAME.pid
+DAEMON_ARGS=""
+SCRIPTNAME=/etc/init.d/$NAME
+RUNASUSER="clearagent"
+
+# Exit if the package is not installed
+[ -x "$DAEMON" ] || exit 0
+
+# Read configuration variable file if it is present
+[ -r /etc/default/$NAME ] && . /etc/default/$NAME
+
+# Load the VERBOSE setting and other rcs variables
+. /lib/init/vars.sh
+
+# Define LSB log_* functions.
+# Depend on lsb-base (>= 3.0-6) to ensure that this file is present.
+. /lib/lsb/init-functions
+
+#
+# Function that starts the daemon/service
+#
+do_start()
+{
+ # Return
+ # 0 if daemon has been started
+ # 1 if daemon was already running
+ # 2 if daemon could not be started
+ start-stop-daemon --start --quiet --pidfile $PIDFILE --exec $DAEMON --test > /dev/null \
+ || return 1
+ start-stop-daemon --start --quiet --pidfile $PIDFILE --exec $DAEMON \
+ --chuid $RUNASUSER \
+ -- $DAEMON_ARGS \
+ || return 2
+}
+
+#
+# Function that stops the daemon/service
+#
+do_stop()
+{
+ # Return
+ # 0 if daemon has been stopped
+ # 1 if daemon was already stopped
+ # 2 if daemon could not be stopped
+ # other if a failure occurred
+ start-stop-daemon --stop --quiet --retry=TERM/30/KILL/5 --pidfile $PIDFILE --name $NAME
+ RETVAL="$?"
+ [ "$RETVAL" = 2 ] && return 2
+ # Wait for children to finish too if this is a daemon that forks
+ # and if the daemon is only ever run from this initscript.
+ # If the above conditions are not satisfied then add some other code
+ # that waits for the process to drop all resources that could be
+ # needed by services started subsequently. A last resort is to
+ # sleep for some time.
+ start-stop-daemon --stop --quiet --oknodo --retry=0/30/KILL/5 --exec $DAEMON
+ [ "$?" = 2 ] && return 2
+ # Many daemons don't delete their pidfiles when they exit.
+ rm -f $PIDFILE
+ return "$RETVAL"
+}
+
+#
+# Function that sends a SIGHUP to the daemon/service
+#
+do_reload() {
+ #
+ # If the daemon can reload its configuration without
+ # restarting (for example, when it is sent a SIGHUP),
+ # then implement that here.
+ #
+ start-stop-daemon --stop --signal 1 --quiet --pidfile $PIDFILE --name $NAME
+ return 0
+}
+
+case "$1" in
+ start)
+ [ "$VERBOSE" != no ] && log_daemon_msg "Starting $DESC" "$NAME"
+ do_start
+ case "$?" in
+ 0|1) [ "$VERBOSE" != no ] && log_end_msg 0 ;;
+ 2) [ "$VERBOSE" != no ] && log_end_msg 1 ;;
+ esac
+ ;;
+ stop)
+ [ "$VERBOSE" != no ] && log_daemon_msg "Stopping $DESC" "$NAME"
+ do_stop
+ case "$?" in
+ 0|1) [ "$VERBOSE" != no ] && log_end_msg 0 ;;
+ 2) [ "$VERBOSE" != no ] && log_end_msg 1 ;;
+ esac
+ ;;
+ status)
+ status_of_proc "$DAEMON" "$NAME" && exit 0 || exit $?
+ ;;
+ #reload|force-reload)
+ #
+ # If do_reload() is not implemented then leave this commented out
+ # and leave 'force-reload' as an alias for 'restart'.
+ #
+ #log_daemon_msg "Reloading $DESC" "$NAME"
+ #do_reload
+ #log_end_msg $?
+ #;;
+ restart|force-reload)
+ #
+ # If the "reload" option is implemented then remove the
+ # 'force-reload' alias
+ #
+ log_daemon_msg "Restarting $DESC" "$NAME"
+ do_stop
+ case "$?" in
+ 0|1)
+ do_start
+ case "$?" in
+ 0) log_end_msg 0 ;;
+ 1) log_end_msg 1 ;; # Old process is still running
+ *) log_end_msg 1 ;; # Failed to start
+ esac
+ ;;
+ *)
+ # Failed to stop
+ log_end_msg 1
+ ;;
+ esac
+ ;;
+ *)
+ #echo "Usage: $SCRIPTNAME {start|stop|restart|reload|force-reload}" >&2
+ echo "Usage: $SCRIPTNAME {start|stop|status|restart|force-reload}" >&2
+ exit 3
+ ;;
+esac
+
+:
--- /dev/null
+#/bin/bash
+#
+# Solaris doesn't support init.d scripts and I'm not writting a bona fide
+# SMF service for this
+exec /opt/clearscm/clearadm/cleartasks.pl
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
use ClearadmWeb;
use Clearadm;
-#use Clearcase;
-#use Clearcase::Views;
+use Clearcase;
+use Clearcase::Views;
use Display;
use Utils;
$data .= '</strike>'
if $system{active} eq 'false';
+ $load{uptime} ||= 'Unknown';
+
display td {class => 'dataCentered'}, "$data ",
font {class => 'dim' }, "<br>Up: $load{uptime}";
} # foreach
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
use DBI;
use File::Basename;
use Net::Domain qw(hostdomain);
+use Sys::Hostname;
use FindBin;
use GetConfig;
use Mail;
-my $conf = dirname (__FILE__) . '/../etc/clearadm.conf';
+my $conf = dirname(__FILE__) . '/../etc/clearadm.conf';
-our %CLEAROPTS = GetConfig ($conf);
+our %CLEAROPTS = GetConfig($conf);
# Globals
our $VERSION = '$Revision: 1.54 $';
my $defaultLoadavgHist = '6 months';
# Internal methods
-sub _dberror ($$) {
+sub _dberror($$) {
my ($self, $msg, $statement) = @_;
my $dberr = $self->{db}->err;
my $message = '';
if ($dberr) {
- my $function = (caller (1)) [3];
+ my $function = (caller(1)) [3];
$message = "$function: $msg\nError #$dberr: $dberrmsg\n"
. "SQL Statement: $statement";
return $dberr, $message;
} # _dberror
-sub _formatValues (@) {
+sub _formatValues(@) {
my ($self, @values) = @_;
my @returnValues;
# Quote data values
- push @returnValues, $_ eq '' ? 'null' : $self->{db}->quote ($_)
+ push @returnValues, $_ eq '' ? 'null' : $self->{db}->quote($_)
for (@values);
return @returnValues;
} # _formatValues
-sub _formatNameValues (%) {
+sub _formatNameValues(%) {
my ($self, %rec) = @_;
my @nameValueStrs;
- push @nameValueStrs, "$_=" . $self->{db}->quote ($rec{$_})
+ push @nameValueStrs, "$_=" . $self->{db}->quote($rec{$_})
for (keys %rec);
return @nameValueStrs;
} # _formatNameValues
-sub _addRecord ($%) {
+sub _addRecord($%) {
my ($self, $table, %rec) = @_;
my $statement = "insert into $table (";
$statement .= join ',', keys %rec;
$statement .= ') values (';
- $statement .= join ',', $self->_formatValues (values %rec);
+ $statement .= join ',', $self->_formatValues(values %rec);
$statement .= ')';
my ($err, $msg);
- $self->{db}->do ($statement);
+ $self->{db}->do($statement);
- return $self->_dberror ("Unable to add record to $table", $statement);
+ return $self->_dberror("Unable to add record to $table", $statement);
} # _addRecord
-sub _deleteRecord ($;$) {
+sub _deleteRecord($;$) {
my ($self, $table, $condition) = @_;
my $count;
$statement .= "where $condition"
if $condition;
- my $sth = $self->{db}->prepare ($statement)
- or return $self->_dberror ('Unable to prepare statement', $statement);
+ my $sth = $self->{db}->prepare($statement)
+ or return $self->_dberror('Unable to prepare statement', $statement);
$sth->execute
- or return $self->_dberror ('Unable to execute statement', $statement);
+ or return $self->_dberror('Unable to execute statement', $statement);
my @row = $sth->fetchrow_array;
$statement .= "where $condition"
if $condition;
- $self->{db}->do ($statement);
+ $self->{db}->do($statement);
if ($self->{db}->err) {
- return $self->_dberror ("Unable to delete record from $table", $statement);
+ return $self->_dberror("Unable to delete record from $table", $statement);
} else {
return $count, 'Records deleted';
} # if
} # _deleteRecord
-sub _updateRecord ($$%) {
+sub _updateRecord($$%) {
my ($self, $table, $condition, %rec) = @_;
my $statement = "update $table set ";
- $statement .= join ',', $self->_formatNameValues (%rec);
+ $statement .= join ',', $self->_formatNameValues(%rec);
$statement .= " where $condition"
if $condition;
- $self->{db}->do ($statement);
+ $self->{db}->do($statement);
- return $self->_dberror ("Unable to update record in $table", $statement);
+ return $self->_dberror("Unable to update record in $table", $statement);
} # _updateRecord
-sub _checkRequiredFields ($$) {
+sub _checkRequiredFields($$) {
my ($fields, $rec) = @_;
for my $fieldname (@$fields) {
return;
} # _checkRequiredFields
-sub _getRecords ($$) {
- my ($self, $table, $condition) = @_;
+sub _getRecords($$;$) {
+ my ($self, $table, $condition, $additional) = @_;
my ($err, $msg);
- my $statement = "select * from $table where $condition";
+ $additional ||= '';
+
+ my $statement = "select * from $table";
+ $statement .= " where $condition" if $condition;
+ $statement .= $additional;
- my $sth = $self->{db}->prepare ($statement);
+ my $sth = $self->{db}->prepare($statement);
unless ($sth) {
- ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
+ ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
croak $msg;
} # if
$err = 0;
last;
} else {
- ($err, $msg) = $self->_dberror ('Unable to execute statement',
+ ($err, $msg) = $self->_dberror('Unable to execute statement',
$statement);
} # if
my $timestamp = YMDHMS;
- $self->Error ("$timestamp: Unable to talk to DB server.\n\n$msg\n\n"
+ $self->Error("$timestamp: Unable to talk to DB server.\n\n$msg\n\n"
. "Will try again in $sleepTime seconds", -1);
# Try to reconnect
- $self->_connect ($self->{dbserver});
+ $self->_connect($self->{dbserver});
sleep $sleepTime;
} # while
- $self->Error ("After $maxAttempts attempts I could not connect to the database", $err)
+ $self->Error("After $maxAttempts attempts I could not connect to the database", $err)
if ($err == 2006 and $attempts > $maxAttempts);
my @records;
} # while
return @records;
-} # _getRecord
+} # _getRecords
-sub _aliasSystem ($) {
+sub _aliasSystem($) {
my ($self, $system) = @_;
- my %system = $self->GetSystem ($system);
+ my %system = $self->GetSystem($system);
if ($system{name}) {
return $system{name};
} # if
} # _aliasSystem
-sub _getLastID () {
+sub _getLastID() {
my ($self) = @_;
my $statement = 'select last_insert_id()';
- my $sth = $self->{db}->prepare ($statement);
+ my $sth = $self->{db}->prepare($statement);
my ($err, $msg);
unless ($sth) {
- ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
+ ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
croak $msg;
} # if
my $status = $sth->execute;
unless ($status) {
- ($err, $msg) = $self->_dberror ('Unable to execute statement', $statement);
+ ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
croak $msg;
} # if
return $row[0];
} # _getLastID
-sub _connect (;$) {
+sub _connect(;$) {
my ($self, $dbserver) = @_;
$dbserver ||= $CLEAROPTS{CLEARADM_SERVER};
my $dbname = 'clearadm';
my $dbdriver = 'mysql';
- $self->{db} = DBI->connect (
+ $self->{db} = DBI->connect(
"DBI:$dbdriver:$dbname:$dbserver",
$CLEAROPTS{CLEARADM_USERNAME},
$CLEAROPTS{CLEARADM_PASSWORD},
{PrintError => 0},
- ) or croak (
+ ) or croak(
"Couldn't connect to $dbname database "
. "as $CLEAROPTS{CLEARADM_USERNAME}\@$CLEAROPTS{CLEARADM_SERVER}"
);
return;
} # _connect
-sub new (;$) {
+sub new(;$) {
my ($class, $dbserver) = @_;
my $self = bless {}, $class;
- $self->_connect ($dbserver);
+ $self->_connect($dbserver);
return $self;
} # new
-sub SetNotify () {
+sub SetNotify() {
my ($self) = @_;
$self->{NOTIFY} = $CLEAROPTS{CLEARADM_NOTIFY};
return;
} # SetNotify
-sub Error ($;$) {
+sub Error($;$) {
my ($self, $msg, $errno) = @_;
# If $errno is specified we need to stop. However we need to notify somebody
if ($errno) {
if ($self->{NOTIFY}) {
- mail (
+ mail(
to => $self->{NOTIFY},
subject => 'Internal error occurred in Clearadm',
data => "<p>An unexpected, internal error occurred in Clearadm:</p><p>$msg</p>",
return;
} # Error
-sub AddSystem (%) {
+sub AddSystem(%) {
my ($self, %system) = @_;
my @requiredFields = (
$system{loadavgHist} ||= $defaultLoadavgHist;
- return $self->_addRecord ('system', %system);
+ return $self->_addRecord('system', %system);
} # AddSystem
-sub DeleteSystem ($) {
+sub DeleteSystem($) {
my ($self, $name) = @_;
- return $self->_deleteRecord ('system', "name='$name'");
+ return $self->_deleteRecord('system', "name='$name'");
} # DeleteSystem
sub UpdateSystem ($%) {
my ($self, $name, %update) = @_;
- return $self->_updateRecord ('system', "name='$name'", %update);
+ return $self->_updateRecord('system', "name='$name'", %update);
} # UpdateSystem
-sub GetSystem ($) {
+sub GetSystem($) {
my ($self, $system) = @_;
return
unless $system;
- my @records = $self->_getRecords (
+ my @records = $self->_getRecords(
'system',
"name='$system' or alias like '%$system%'"
);
} # if
} # GetSystem
-sub FindSystem (;$) {
+sub FindSystem(;$) {
my ($self, $system) = @_;
$system ||= '';
my $condition = "name like '%$system%' or alias like '%$system%'";
- return $self->_getRecords ('system', $condition);
+ return $self->_getRecords('system', $condition);
} # FindSystem
-sub SearchSystem (;$) {\r
+sub SearchSystem(;$) {\r
my ($self, $condition) = @_;
$condition = "name like '%'" unless $condition;
- return $self->_getRecords ('system', $condition);\r
+ return $self->_getRecords('system', $condition);\r
} # SearchSystem
-sub AddPackage (%) {
+sub AddPackage(%) {
my ($self, %package) = @_;
my @requiredFields = (
return -1, "AddPackage: $result"
if $result;
- return $self->_addRecord ('package', %package);
+ return $self->_addRecord('package', %package);
} # AddPackage
-sub DeletePackage ($$) {
+sub DeletePackage($$) {
my ($self, $system, $name) = @_;
- return $self->_deleteRecord (
+ return $self->_deleteRecord(
'package',
"(system='$system' or alias='$system') and name='$name'");
} # DeletePackage
-sub UpdatePackage ($$%) {
+sub UpdatePackage($$%) {
my ($self, $system, $name, %update) = @_;
- $system = $self->_aliasSystem ($system);
+ $system = $self->_aliasSystem($system);
return
unless $system;
- return $self->_updateRecord ('package', "system='$system'", %update);
+ return $self->_updateRecord('package', "system='$system'", %update);
} # UpdatePackage
sub GetPackage($$) {
my ($self, $system, $name) = @_;
- $system = $self->_aliasSystem ($system);
+ $system = $self->_aliasSystem($system);
return
unless $system;
return
unless $name;
- my @records = $self->_getRecords (
+ my @records = $self->_getRecords(
'package',
"system='$system' and name='$name'"
);
} # if
} # GetPackage
-sub FindPackage ($;$) {
+sub FindPackage($;$) {
my ($self, $system, $name) = @_;
$name ||= '';
- $system = $self->_aliasSystem ($system);
+ $system = $self->_aliasSystem($system);
return
unless $system;
my $condition = "system='$system' and name like '%$name%'";
- return $self->_getRecords ('package', $condition);
+ return $self->_getRecords('package', $condition);
} # FindPackage
-sub AddFilesystem (%) {
+sub AddFilesystem(%) {
my ($self, %filesystem) = @_;
my @requiredFields = (
# Default filesystem threshold
$filesystem{threshold} ||= $defaultFilesystemThreshold;
- return $self->_addRecord ('filesystem', %filesystem);
+ return $self->_addRecord('filesystem', %filesystem);
} # AddFilesystem
-sub DeleteFilesystem ($$) {
+sub DeleteFilesystem($$) {
my ($self, $system, $filesystem) = @_;
- $system = $self->_aliasSystem ($system);
+ $system = $self->_aliasSystem($system);
return
unless $system;
- return $self->_deleteRecord (
+ return $self->_deleteRecord(
'filesystem',
"system='$system' and filesystem='$filesystem'"
);
} # DeleteFilesystem
-sub UpdateFilesystem ($$%) {
+sub UpdateFilesystem($$%) {
my ($self, $system, $filesystem, %update) = @_;
- $system = $self->_aliasSystem ($system);
+ $system = $self->_aliasSystem($system);
return
unless $system;
- return $self->_updateRecord (
+ return $self->_updateRecord(
'filesystem',
"system='$system' and filesystem='$filesystem'",
%update
);
} # UpdateFilesystem
-sub GetFilesystem ($$) {
+sub GetFilesystem($$) {
my ($self, $system, $filesystem) = @_;
- $system = $self->_aliasSystem ($system);
+ $system = $self->_aliasSystem($system);
return
unless $system;
return
unless $filesystem;
- my @records = $self->_getRecords (
+ my @records = $self->_getRecords(
'filesystem',
"system='$system' and filesystem='$filesystem'"
);
} # if
} # GetFilesystem
-sub FindFilesystem ($;$) {
+sub FindFilesystem($;$) {
my ($self, $system, $filesystem) = @_;
$filesystem ||= '';
- $system = $self->_aliasSystem ($system);
+ $system = $self->_aliasSystem($system);
return
unless $system;
my $condition = "system='$system' and filesystem like '%$filesystem%'";
- return $self->_getRecords ('filesystem', $condition);
+ return $self->_getRecords('filesystem', $condition);
} # FindFilesystem
-sub AddVob (%) {
+sub AddVob(%) {
my ($self, %vob) = @_;
my @requiredFields = (
return -1, "AddVob: $result"
if $result;
- return $self->_addRecord ('vob', %vob);
+ return $self->_addRecord('vob', %vob);
} # AddVob
-sub DeleteVob ($) {
+sub DeleteVob($) {
my ($self, $tag) = @_;
- return $self->_deleteRecord ('vob', "tag='$tag'");
+ return $self->_deleteRecord('vob', "tag='$tag'");
} # DeleteVob
-sub GetVob ($) {
+sub GetVob($) {
my ($self, $tag) = @_;
return
unless $tag;
- my @records = $self->_getRecords ('vob', "tag='$tag'");
+ my @records = $self->_getRecords('vob', "tag='$tag'");
if ($records[0]) {
return %{$records[0]};
} # if
} # GetVob
-sub FindVob ($) {
+sub FindVob($) {
my ($self, $tag) = @_;
- return $self->_getRecords ('vob', "tag like '%$tag%'");
+ return $self->_getRecords('vob', "tag like '%$tag%'");
} # FindVob
-sub AddView (%) {
+sub AddView(%) {
my ($self, %view) = @_;
my @requiredFields = (
return -1, "AddView: $result"
if $result;
- return $self->_addRecord ('view', %view);
+ return $self->_addRecord('view', %view);
} # AddView
-sub DeleteView ($) {
+sub DeleteView($) {
my ($self, $tag) = @_;
- return $self->_deleteRecord ('vob', "tag='$tag'");
+ return $self->_deleteRecord('vob', "tag='$tag'");
} # DeleteView
-sub GetView ($) {
- my ($self, $tag) = @_;
+sub UpdateView($$) {
+ my ($self, $tag, $region, %viewRec) = @_;
- return
- unless $tag;
+ return $self->_updateRecord('view', "tag='$tag' and region='$region'", %viewRec);
+} # UpdateView
+
+sub GetView($$) {
+ my ($self, $tag, $region) = @_;
+
+ return unless $tag;
- my @records = $self->_getRecords ('view', "tag='$tag'");
+ my @records = $self->_getRecords('view', "tag='$tag' and region='$region'");
if ($records[0]) {
return %{$records[0]};
} else {
- return;
+ return;
} # if
} # GetView
-sub FindView (;$$$$) {
+sub FindView(;$$$$) {
my ($self, $system, $region, $tag, $ownerName) = @_;
$system ||= '';
$condition .= ' and ';
$condition .= "ownerName like '%$ownerName'";
- return $self->_getRecords ('view', $condition);
+ return $self->_getRecords('view', $condition);
} # FindView
-sub AddFS (%) {
+sub AddFS(%) {
my ($self, %fs) = @_;
my @requiredFields = (
# Timestamp record
$fs{timestamp} = Today2SQLDatetime;
- return $self->_addRecord ('fs', %fs);
+ return $self->_addRecord('fs', %fs);
} # AddFS
-sub TrimFS ($$) {
+sub TrimFS($$) {
my ($self, $system, $filesystem) = @_;
- my %filesystem = $self->GetFilesystem ($system, $filesystem);
+ my %filesystem = $self->GetFilesystem($system, $filesystem);
return
unless %filesystem;
- my %task = $self->GetTask ('scrub');
+ my %task = $self->GetTask('scrub');
- $self->Error ("Unable to find scrub task!", 1) unless %task;
+ $self->Error("Unable to find scrub task!", 1) unless %task;
my $days;
my $today = Today2SQLDatetime;
my $oldage = SubtractDays $today, $days;
- my ($dberr, $dbmsg) = $self->_deleteRecord (
+ my ($dberr, $dbmsg) = $self->_deleteRecord(
'fs',
"system='$system' and filesystem='$filesystem' and timestamp<='$oldage'"
);
$runlog{message} =
"Scrubbed $dberr fs records for filesystem $system:$filesystem";
- my ($err, $msg) = $self->AddRunlog (%runlog);
+ my ($err, $msg) = $self->AddRunlog(%runlog);
- $self->Error ("Unable to add runlog - (Error: $err)\n$msg") if $err;
+ $self->Error("Unable to add runlog - (Error: $err)\n$msg") if $err;
} # if
return ($dberr, $dbmsg);
} # TrimFS
-sub TrimLoadavg ($) {
+sub TrimLoadavg($) {
my ($self, $system) = @_;
- my %system = $self->GetSystem ($system);
+ my %system = $self->GetSystem($system);
return
unless %system;
- my %task = $self->GetTask ('loadavg');
+ my %task = $self->GetTask('loadavg');
- $self->Error ("Unable to find loadavg task!", 1) unless %task;
+ $self->Error("Unable to find loadavg task!", 1) unless %task;
my $days;
my $today = Today2SQLDatetime;
my $oldage = SubtractDays $today, $days;
- my ($dberr, $dbmsg) = $self->_deleteRecord (
+ my ($dberr, $dbmsg) = $self->_deleteRecord(
'loadavg',
"system='$system' and timestamp<='$oldage'"
);
$runlog{message} =
"Scrubbed $dberr loadavg records for system $system";
- my ($err, $msg) = $self->AddRunlog (%runlog);
+ my ($err, $msg) = $self->AddRunlog(%runlog);
- $self->Error ("Unable to add runload (Error: $err)\n$msg") if $err;
+ $self->Error("Unable to add runload (Error: $err)\n$msg") if $err;
} # if
return ($dberr, $dbmsg);
} # TrimLoadavg
-sub GetFS ($$;$$$$) {
+sub GetFS($$;$$$$) {
my ($self, $system, $filesystem, $start, $end, $count, $interval) = @_;
- $system = $self->_aliasSystem ($system);
+ $system = $self->_aliasSystem($system);
return
unless $system;
# returns 40 rows we'll see only rows 1-10, not rows 31-40). We need limit
# $offset, $count where $offset = the number of qualifying records minus
# $count
- my $nbrRecs = $self->Count ('fs', $condition);
+ my $nbrRecs = $self->Count('fs', $condition);
my $offset = $nbrRecs - $count;
# Offsets of < 0 are not allowed.
my ($err, $msg);
- my $sth = $self->{db}->prepare ($statement);
+ my $sth = $self->{db}->prepare($statement);
unless ($sth) {
- ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
+ ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
croak $msg;
} # if
my $status = $sth->execute;
unless ($status) {
- ($err, $msg) = $self->_dberror ('Unable to execute statement', $statement);
+ ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
croak $msg;
} # if
return @records;
} # GetFS
-sub GetLatestFS ($$) {
+sub GetLatestFS($$) {
my ($self, $system, $filesystem) = @_;
- $system = $self->_aliasSystem ($system);
+ $system = $self->_aliasSystem($system);
return
unless $system;
return
unless $filesystem;
- my @records = $self->_getRecords (
+ my @records = $self->_getRecords(
'fs',
"system='$system' and filesystem='$filesystem'"
. " order by timestamp desc limit 0, 1",
} # if
} # GetLatestFS
-sub AddLoadavg () {
+sub AddLoadavg() {
my ($self, %loadavg) = @_;
my @requiredFields = (
# Timestamp record
$loadavg{timestamp} = Today2SQLDatetime;
- return $self->_addRecord ('loadavg', %loadavg);
+ return $self->_addRecord('loadavg', %loadavg);
} # AddLoadavg
-sub GetLoadavg ($;$$$$) {
+sub GetLoadavg($;$$$$) {
my ($self, $system, $start, $end, $count, $interval) = @_;
- $system = $self->_aliasSystem ($system);
+ $system = $self->_aliasSystem($system);
return
unless $system;
# returns 40 rows we'll see only rows 1-10, not rows 31-40). We need limit
# $offset, $count where $offset = the number of qualifying records minus
# $count
- my $nbrRecs = $self->Count ('loadavg', $condition);
+ my $nbrRecs = $self->Count('loadavg', $condition);
my $offset = $nbrRecs - $count;
# Offsets of < 0 are not allowed.
my ($err, $msg);
- my $sth = $self->{db}->prepare ($statement);
+ my $sth = $self->{db}->prepare($statement);
unless ($sth) {
- ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
+ ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
croak $msg;
} # if
my $status = $sth->execute;
unless ($status) {
- ($err, $msg) = $self->_dberror ('Unable to execute statement', $statement);
+ ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
croak $msg;
} # if
return @records;
} # GetLoadvg
-sub GetLatestLoadavg ($) {
+sub GetLatestLoadavg($) {
my ($self, $system) = @_;
- $system = $self->_aliasSystem ($system);
+ $system = $self->_aliasSystem($system);
return
unless $system;
- my @records = $self->_getRecords (
+ my @records = $self->_getRecords(
'loadavg',
"system='$system'"
. " order by timestamp desc limit 0, 1",
} # if
} # GetLatestLoadavg
-sub AddTask (%) {
+sub GetStorage($$$;$$$$$) {
+ my ($self, $type, $tag, $storage, $region, $start, $end, $count, $interval) = @_;
+
+ $interval ||= 'Day';
+ $region ||= $Clearcase::CC->region;
+
+ return unless $type =~ /vob/i or $type =~ /view/;
+
+ my $size = $interval =~ /month/i
+ ? 7
+ : $interval =~ /day/i
+ ? 10
+ : $interval =~ /hour/i
+ ? 13
+ : 16;
+
+ undef $start if $start and $start =~ /earliest/i;
+ undef $end if $end and $end =~ /latest/i;
+
+ my $condition;
+ my $table = $type eq 'vob' ? 'vobstorage' : 'viewstorage';
+
+ $condition = "tag='$tag' and region='$region'";
+ $condition .= " and timestamp>='$start'" if $start;
+ $condition .= " and timestamp<='$end'" if $end;
+
+ $condition .= " group by left(timestamp,$size)";
+
+ if ($count) {
+ # We can't simply do a "limit 0, $count" as that just gets the front end of
+ # the records return (i.e. if $count = say 10 and the timestamp range
+ # returns 40 rows we'll see only rows 1-10, not rows 31-40). We need limit
+ # $offset, $count where $offset = the number of qualifying records minus
+ # $count
+ my $nbrRecs = $self->Count($table, $condition);
+ my $offset = $nbrRecs - $count;
+
+ # Offsets of < 0 are not allowed.
+ $offset = 0 if $offset < 0;
+
+ $condition .= " limit $offset, $count";
+ } # if
+
+ my $statement = <<"END";
+select
+ tag,
+ region,
+ left(timestamp,$size) as timestamp,
+ avg($storage) as size
+from
+ $table
+ where $condition
+END
+
+ my ($err, $msg);
+
+ my $sth = $self->{db}->prepare($statement);
+
+ unless ($sth) {
+ ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
+
+ croak $msg;
+ } # if
+
+ my $status = $sth->execute;
+
+ unless ($status) {
+ ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
+
+ croak $msg;
+ } # if
+
+ my @records;
+
+ while (my $row = $sth->fetchrow_hashref) {
+ push @records, $row;
+ } # while
+
+ return @records;
+} # GetStorage
+
+sub AddTask(%) {
my ($self, %task) = @_;
my @requiredFields = (
return -1, "AddTask: $result"
if $result;
- return $self->_addRecord ('task', %task);
+ return $self->_addRecord('task', %task);
} # AddTask
-sub DeleteTask ($) {
+sub DeleteTask($) {
my ($self, $name) = @_;
- return $self->_deleteRecord ('task', "name='$name'");
+ return $self->_deleteRecord('task', "name='$name'");
} # DeleteTask
-sub FindTask ($) {
+sub FindTask($) {
my ($self, $name) = @_;
$name ||= '';
my $condition = "name like '%$name%'";
- return $self->_getRecords ('task', $condition);
+ return $self->_getRecords('task', $condition);
} # FindTask
-sub GetTask ($) {
+sub GetTask($) {
my ($self, $name) = @_;
return
unless $name;
- my @records = $self->_getRecords ('task', "name='$name'");
+ my @records = $self->_getRecords('task', "name='$name'");
if ($records[0]) {
return %{$records[0]};
} # if
} # GetTask
-sub UpdateTask ($%) {
+sub UpdateTask($%) {
my ($self, $name, %update) = @_;
- return $self->_updateRecord ('task', "name='$name'", %update);
+ return $self->_updateRecord('task', "name='$name'", %update);
} # Update
-sub AddSchedule (%) {
+sub AddSchedule(%) {
my ($self, %schedule) = @_;
my @requiredFields = (
return -1, "AddSchedule: $result"
if $result;
- return $self->_addRecord ('schedule', %schedule);
+ return $self->_addRecord('schedule', %schedule);
} # AddSchedule
-sub DeleteSchedule ($) {
+sub DeleteSchedule($) {
my ($self, $name) = @_;
- return $self->_deleteRecord ('schedule', "name='$name'");
+ return $self->_deleteRecord('schedule', "name='$name'");
} # DeleteSchedule
-sub FindSchedule (;$$) {
+sub FindSchedule(;$$) {
my ($self, $name, $task) = @_;
$name ||= '';
$condition .= ' and ';
$condition .= "task like '%$task%'";
- return $self->_getRecords ('schedule', $condition);
+ return $self->_getRecords('schedule', $condition);
} # FindSchedule
-sub GetSchedule ($) {
+sub GetSchedule($) {
my ($self, $name) = @_;
- my @records = $self->_getRecords ('schedule', "name='$name'");
+ my @records = $self->_getRecords('schedule', "name='$name'");
if ($records[0]) {
return %{$records[0]};
} # if
} # GetSchedule
-sub UpdateSchedule ($%) {
+sub UpdateSchedule($%) {
my ($self, $name, %update) = @_;
- return $self->_updateRecord ('schedule', "name='$name'", %update);
+ return $self->_updateRecord('schedule', "name='$name'", %update);
} # UpdateSchedule
-sub AddRunlog (%) {
+sub AddRunlog(%) {
my ($self, %runlog) = @_;
my @requiredFields = (
$runlog{ended} = Today2SQLDatetime;
- my ($err, $msg) = $self->_addRecord ('runlog', %runlog);
+ $runlog{system} = hostname if $runlog{system} =~ /localhost/i;
+
+ my ($err, $msg) = $self->_addRecord('runlog', %runlog);
return ($err, $msg, $self->_getLastID);
} # AddRunlog
-sub DeleteRunlog ($) {
+sub DeleteRunlog($) {
my ($self, $condition) = @_;
- return $self->_deleteRecord ('runlog', $condition);
+ return $self->_deleteRecord('runlog', $condition);
} # DeleteRunlog
-sub FindRunlog (;$$$$$$) {
+sub FindRunlog(;$$$$$$) {
my ($self, $task, $system, $status, $id, $start, $page) = @_;
- $task ||= '';
-
# If ID is specified then that's all that really matters as it uniquely
# identifies a runlog entry;
- my $condition;
+ my ($condition, $conditions);
+ my $limit = '';
unless ($id) {
- $condition = "task like '%$task%'";
+ if ($task !~ /all/i) {
+ $conditions++;
+ $condition = "task like '%$task%'";
+ } # if
- if ($system) {
- $condition .= " and system like '%$system%'"
- unless $system eq 'All';
- } else {
- $condition .= ' and system is null';
- } # unless
+ if ($system !~ /all/i) {
+ $condition .= ' and ' if $conditions;
+ $condition .= "system like '%$system%'";
+ $conditions++;
+ } # if
+
+ if ($status) {
+ $condition .= ' and ' if $conditions;
- if (defined $status) {
if ($status =~ /!(-*\d+)/) {
- $condition .= " and status<>$1";
+ $condition .= "status<>$1";
} else {
- $condition .= " and status=$status"
+ $condition .= "status=$status"
} # if
} # if
- $condition .= " order by started desc";
-
+ # Need defined here as $start may be 0!
if (defined $start) {
$page ||= 10;
- $condition .= " limit $start, $page";
+ $limit = "limit $start, $page";
} # unless
} else {
$condition = "id=$id";
} # unless
- return $self->_getRecords ('runlog', $condition);
+ return $self->_getRecords('runlog', $condition, " order by started desc $limit");
} # FindRunlog
-sub GetRunlog ($) {
+sub GetRunlog($) {
my ($self, $id) = @_;
return
unless $id;
- my @records = $self->_getRecords ('runlog', "id=$id");
+ my @records = $self->_getRecords('runlog', "id=$id");
if ($records[0]) {
return %{$records[0]};
} # if
} # GetRunlog
-sub UpdateRunlog ($%) {
+sub UpdateRunlog($%) {
my ($self, $id, %update) = @_;
- return $self->_updateRecord ('runlog', "id=$id", %update);
+ return $self->_updateRecord('runlog', "id=$id", %update);
} # UpdateRunlog
-sub Count ($;$) {
+sub Count($;$) {
my ($self, $table, $condition) = @_;
$condition = $condition ? 'where ' . $condition : '';
my $statement = "select count(*) from $table $condition";
- my $sth = $self->{db}->prepare ($statement);
+ my $sth = $self->{db}->prepare($statement);
unless ($sth) {
- ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
+ ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
croak $msg;
} # if
my $status = $sth->execute;
unless ($status) {
- ($err, $msg) = $self->_dberror ('Unable to execute statement', $statement);
+ ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
croak $msg;
} # if
# execute the work to be done, timing it, and subtracting it from the $sleep
# time returned. If the caller exhausts the $sleep time then they should call
# us again.
-sub GetWork () {
+sub GetWork() {
my ($self) = @_;
my ($err, $msg);
order by lastrun
END
- my $sth = $self->{db}->prepare ($statement);
+ my $sth = $self->{db}->prepare($statement);
unless ($sth) {
- ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
+ ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
croak $msg;
} # if
my $status = $sth->execute;
unless ($status) {
- ($err, $msg) = $self->_dberror ('Unable to execute statement', $statement);
+ ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
croak $msg;
} # if
while (my $row = $sth->fetchrow_hashref) {
if ($$row{system} !~ /localhost/i) {
- my %system = $self->GetSystem ($$row{system});
+ my %system = $self->GetSystem($$row{system});
# Skip inactive systems
next if $system{active} eq 'false';
} # if
my $today = Today2SQLDatetime;
- my $lastrun = Add ($$row{lastrun}, (seconds => $seconds));
- my $waitTime = DateToEpoch ($lastrun) - DateToEpoch ($today);
+ my $lastrun = Add($$row{lastrun}, (seconds => $seconds));
+ my $waitTime = DateToEpoch($lastrun) - DateToEpoch($today);
if ($waitTime < 0) {
# We're late - push this onto records and move on
return ($sleep, @records);
} # GetWork
-sub GetUniqueList ($$) {
+sub GetUniqueList($$) {
my ($self, $table, $field) = @_;
my ($err, $msg);
my $statement = "select $field from $table group by $field";
- my $sth = $self->{db}->prepare ($statement);
+ my $sth = $self->{db}->prepare($statement);
unless ($sth) {
- ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
+ ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
croak $msg;
} # if
my $status = $sth->execute;
unless ($status) {
- ($err, $msg) = $self->_dberror ('Unable to execute statement', $statement);
+ ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
croak $msg;
} # if
return -1, "AddAlert: $result"
if $result;
- return $self->_addRecord ('alert', %alert);
+ return $self->_addRecord('alert', %alert);
} # AddAlert
-sub DeleteAlert ($) {
+sub DeleteAlert($) {
my ($self, $name) = @_;
- return $self->_deleteRecord ('alert', "name='$name'");
+ return $self->_deleteRecord('alert', "name='$name'");
} # DeleteAlert
-sub FindAlert (;$) {
+sub FindAlert(;$) {
my ($self, $alert) = @_;
$alert ||= '';
my $condition = "name like '%$alert%'";
- return $self->_getRecords ('alert', $condition);
+ return $self->_getRecords('alert', $condition);
} # FindAlert
-sub GetAlert ($) {
+sub GetAlert($) {
my ($self, $name) = @_;
return
unless $name;
- my @records = $self->_getRecords ('alert', "name='$name'");
+ my @records = $self->_getRecords('alert', "name='$name'");
if ($records[0]) {
return %{$records[0]};
} # if
} # GetAlert
-sub SendAlert ($$$$$$$) {
+sub SendAlert($$$$$$$) {
my (
$self,
$alert,
$footing .= "<a href='$CLEAROPTS{CLEARADM_WEBBASE}'>Clearadm</a><br>";
$footing .= "Copyright © $year, ClearSCM, Inc. - All rights reserved";
- my %alert = $self->GetAlert ($alert);
+ my %alert = $self->GetAlert($alert);
if ($alert{type} eq 'email') {
my $from = 'Clearadm@' . hostdomain;
- mail (
+ mail(
from => $from,
to => $to,
subject => "Clearadm Alert: $system: $subject",
footing => $footing,
);
} else {
- $self->Error ("Don't know how to send $alert{type} alerts\n"
+ $self->Error("Don't know how to send $alert{type} alerts\n"
. "Subject: $subject\n"
. "Message: $message", 1);
} # if
message => $subject,
);
- return $self->AddAlertlog (%alertlog);
+ return $self->AddAlertlog(%alertlog);
} # SendAlert
-sub GetLastAlert ($$) {
+sub GetLastAlert($$) {
my ($self, $notification, $system) = @_;
my $statement = <<"END";
0, 1
END
- my $sth = $self->{db}->prepare ($statement)
- or return $self->_dberror ('Unable to prepare statement', $statement);
+ my $sth = $self->{db}->prepare($statement)
+ or return $self->_dberror('Unable to prepare statement', $statement);
$sth->execute
- or return $self->_dberror ('Unable to execute statement', $statement);
+ or return $self->_dberror('Unable to execute statement', $statement);
my $alertlog= $sth->fetchrow_hashref;
} # if
} # GetLastAlert
-sub GetLastTaskFailure ($$) {
+sub GetLastTaskFailure($$) {
my ($self, $task, $system) = @_;
my $statement = <<"END";
0, 1
END
- my $sth = $self->{db}->prepare ($statement)
- or return $self->_dberror ('Unable to prepare statement', $statement);
+ my $sth = $self->{db}->prepare($statement)
+ or return $self->_dberror('Unable to prepare statement', $statement);
$sth->execute
- or return $self->_dberror ('Unable to execute statement', $statement);
+ or return $self->_dberror('Unable to execute statement', $statement);
my $runlog= $sth->fetchrow_hashref;
0, 1
END
- $sth = $self->{db}->prepare ($statement)
- or return $self->_dberror ('Unable to prepare statement', $statement);
+ $sth = $self->{db}->prepare($statement)
+ or return $self->_dberror('Unable to prepare statement', $statement);
$sth->execute
- or return $self->_dberror ('Unable to execute statement', $statement);
+ or return $self->_dberror('Unable to execute statement', $statement);
$runlog = $sth->fetchrow_hashref;
} # if
} # GetLastTaskFailure
-sub Notify ($$$$$$) {
+sub Notify($$$$$$) {
my (
$self,
$notification,
# Update filesystem, if $filesystem was specified
if ($filesystem) {
- ($err, $msg) = $self->UpdateFilesystem (
+ ($err, $msg) = $self->UpdateFilesystem(
$system,
$filesystem, (
notification => $notification,
),
);
- $self->Error ("Unable to set notification for filesystem $system:$filesystem "
+ $self->Error("Unable to set notification for filesystem $system:$filesystem "
. "(Status: $err)\n$msg", $err) if $err;
} # if
# Update system
- ($err, $msg) = $self->UpdateSystem (
+ ($err, $msg) = $self->UpdateSystem(
$system, (
notification => $notification,
),
);
- my %notification = $self->GetNotification ($notification);
+ my %notification = $self->GetNotification($notification);
- my %lastnotified = $self->GetLastAlert ($notification, $system);
+ my %lastnotified = $self->GetLastAlert($notification, $system);
if (%lastnotified and $lastnotified{timestamp}) {
my $today = Today2SQLDatetime;
my $lastnotified = $lastnotified{timestamp};
if ($notification{nomorethan} =~ /hour/i) {
- $lastnotified = Add ($lastnotified, (hours => 1));
+ $lastnotified = Add($lastnotified, (hours => 1));
} elsif ($notification{nomorethan} =~ /day/i) {
- $lastnotified = Add ($lastnotified, (days => 1));
+ $lastnotified = Add($lastnotified, (days => 1));
} elsif ($notification{nomorethan} =~ /week/i) {
- $lastnotified = Add ($lastnotified, (days => 7));
+ $lastnotified = Add($lastnotified, (days => 7));
} elsif ($notification{nomorethan} =~ /month/i) {
- $lastnotified = Add ($lastnotified, (month => 1));
+ $lastnotified = Add($lastnotified, (month => 1));
} # if
# If you want to fake an alert in the debugger just change $diff accordingly
- my $diff = Compare ($today, $lastnotified);
+ my $diff = Compare($today, $lastnotified);
return
if $diff <= 0;
my $when = Today2SQLDatetime;
my $nomorethan = lc $notification{nomorethan};
- my %alert = $self->GetAlert ($notification{alert});
+ my %alert = $self->GetAlert($notification{alert});
my $to = $alert{who};
# If $to is null then this means to send the alert to the admin for the
# machine.
unless ($to) {
if ($system) {
- my %system = $self->GetSystem ($system);
+ my %system = $self->GetSystem($system);
$to = $system{email};
} else {
$message .= "<p>You will receive this alert no more than $nomorethan.</p>";
- ($err, $msg) = $self->SendAlert (
+ ($err, $msg) = $self->SendAlert(
$notification{alert},
$system,
$notification{name},
$runlogID,
);
- $self->Error ("Unable to send alert (Status: $err)\n$msg", $err) if $err;
+ $self->Error("Unable to send alert (Status: $err)\n$msg", $err) if $err;
verbose "Sent alert to $to";
# Update runlog to indicate we notified the user for this execution
- ($err, $msg) = $self->UpdateRunlog (
+ ($err, $msg) = $self->UpdateRunlog(
$runlogID, (
alerted => 'true',
),
);
- $self->Error ("Unable to update runlog (Status: $err)\n$msg", $err) if $err;
+ $self->Error("Unable to update runlog (Status: $err)\n$msg", $err) if $err;
return;
} # Notify
-sub ClearNotifications ($$;$) {
+sub ClearNotifications($$;$) {
my ($self, $system, $filesystem) = @_;
my ($err, $msg);
if ($filesystem) {
- ($err, $msg) = $self->UpdateFilesystem (
+ ($err, $msg) = $self->UpdateFilesystem(
$system,
$filesystem, (notification => undef),
);
# 'Filesystem' then we can toggle off the notification on the system too
my $filesystemsAlerted = 0;
- for ($self->FindFilesystem ($system)) {
+ for ($self->FindFilesystem($system)) {
$filesystemsAlerted++
if $$_{notification};
} # for
- my %system = $self->GetSystem ($system);
+ my %system = $self->GetSystem($system);
return
unless $system;
if ($system{notification} and
$system{notification} eq 'Filesystem' and
$filesystemsAlerted == 0) {
- ($err, $msg) = $self->UpdateSystem ($system, (notification => undef));
+ ($err, $msg) = $self->UpdateSystem($system, (notification => undef));
- $self->Error ("Unable to clear notification for system $system "
+ $self->Error("Unable to clear notification for system $system "
. "(Status: $err)\n$msg", $err) if $err;
} # if
} else {
- ($err, $msg) = $self->UpdateSystem ($system, (notification => undef));
+ ($err, $msg) = $self->UpdateSystem($system, (notification => undef));
- $self->Error ("Unable to clear notification for system $system "
+ $self->Error("Unable to clear notification for system $system "
. "(Status: $err)\n$msg", $err) if $err;
} # if
return;
} # ClearNotifications
-sub SystemAlive (%) {
+sub SystemAlive(%) {
my ($self, %system) = @_;
# If we've never heard from this system then we will assume that the system
my $tenMinutes = 10 * 60;
- $lastheardfrom = Add ($lastheardfrom, (seconds => $tenMinutes));
+ $lastheardfrom = Add($lastheardfrom, (seconds => $tenMinutes));
- if (DateToEpoch ($lastheardfrom) < DateToEpoch ($today)) {
- $self->UpdateSystem (
+ if (DateToEpoch($lastheardfrom) < DateToEpoch($today)) {
+ $self->UpdateSystem(
$system{name}, (
notification => 'Heartbeat'
),
return;
} else {
if ($system{notification}) {
- $self->UpdateSystem (
+ $self->UpdateSystem(
$system{name}, (
notification => undef
),
} # if
} # SystemAlive
-sub UpdateAlert ($%) {
+sub UpdateAlert($%) {
my ($self, $name, %update) = @_;
- return $self->_updateRecord (
+ return $self->_updateRecord(
'alert',
"name='$name'",
%update
);
} # UpdateAlert
-sub AddAlertlog (%) {
+sub AddAlertlog(%) {
my ($self, %alertlog) = @_;
my @requiredFields = (
# Timestamp record
$alertlog{timestamp} = Today2SQLDatetime;
- return $self->_addRecord ('alertlog', %alertlog);
+ return $self->_addRecord('alertlog', %alertlog);
} # AddAlertlog
-sub DeleteAlertlog ($) {
+sub DeleteAlertlog($) {
my ($self, $condition) = @_;
return
unless $condition;
if ($condition =~ /all/i) {
- return $self->_deleteRecord ('alertlog');
+ return $self->_deleteRecord('alertlog');
} else {
- return $self->_deleteRecord ('alertlog', $condition);
+ return $self->_deleteRecord('alertlog', $condition);
} # if
} # DeleteAlertlog
-sub FindAlertlog (;$$$$$) {
+sub FindAlertlog(;$$$$$) {
my ($self, $alert, $system, $notification, $start, $page) = @_;
$alert ||= '';
$condition .= " limit $start, $page";
} # unless
- return $self->_getRecords ('alertlog', $condition);
+ return $self->_getRecords('alertlog', $condition);
} # FindAlertLog
-sub GetAlertlog ($) {
+sub GetAlertlog($) {
my ($self, $alert) = @_;
return
unless $alert;
- my @records = $self->_getRecords ('alertlog', "alert='$alert'");
+ my @records = $self->_getRecords('alertlog', "alert='$alert'");
if ($records[0]) {
return %{$records[0]};
} # if
} # GetAlertlog
-sub UpdateAlertlog ($%) {
+sub UpdateAlertlog($%) {
my ($self, $alert, %update) = @_;
- return $self->_updateRecord (
+ return $self->_updateRecord(
'alertlog',
"alert='$alert'",
%update
);
} # UpdateAlertlog
-sub AddNotification (%) {
+sub AddNotification(%) {
my ($self, %notification) = @_;
my @requiredFields = (
return -1, "AddNotification: $result"
if $result;
- return $self->_addRecord ('notification', %notification);
+ return $self->_addRecord('notification', %notification);
} # AddNotification
-sub DeleteNotification ($) {
+sub DeleteNotification($) {
my ($self, $name) = @_;
- return $self->_deleteRecord ('notification', "name='$name'");
+ return $self->_deleteRecord('notification', "name='$name'");
} # DeletePackage
-sub FindNotification (;$$) {
+sub FindNotification(;$$) {
my ($self, $name, $cond, $ordering) = @_;
$name ||= '';
$condition .= " and $cond"
if $cond;
- return $self->_getRecords ('notification', $condition);
+ return $self->_getRecords('notification', $condition);
} # FindNotification
-sub GetNotification ($) {
+sub GetNotification($) {
my ($self, $name) = @_;
return
unless $name;
- my @records = $self->_getRecords ('notification', "name='$name'");
+ my @records = $self->_getRecords('notification', "name='$name'");
if ($records[0]) {
return %{$records[0]};
} # if
} # GetNotification
-sub UpdateNotification ($%) {
+sub UpdateNotification($%) {
my ($self, $name, %update) = @_;
- return $self->_updateRecord (
+ return $self->_updateRecord(
'notification',
"name='$name'",
%update
);
} # UpdateNotification
+sub AddVobStorage(%) {
+ my ($self, %vobstorage) = @_;
+
+ my @requiredFields = (
+ 'tag',
+ );
+
+ my $result = _checkRequiredFields \@requiredFields, \%vobstorage;
+
+ return -1, "AddVobStorage: $result" if $result;
+
+ # Timestamp record
+ $vobstorage{timestamp} = Today2SQLDatetime;
+
+ return $self->_addRecord('vobstorage', %vobstorage);
+} # AddVobStorage
+
+sub AddViewStorage(%) {
+ my ($self, %viewstorage) = @_;
+
+ my @requiredFields = (
+ 'tag',
+ );
+
+ my $result = _checkRequiredFields \@requiredFields, \%viewstorage;
+
+ return -1, "AddViewStorage: $result" if $result;
+
+ # Timestamp record
+ $viewstorage{timestamp} = Today2SQLDatetime;
+
+ return $self->_addRecord('viewstorage', %viewstorage);
+} # AddViewStorage
+
1;
=pod
use lib "$FindBin::Bin/../../lib";
use Clearadm;
+use Clearcase::Vobs;
+use Clearcase::Views;
use DateUtils;
use Display;
use Utils;
makeFilesystemDropdown
makeIntervalDropdown
makeNotificationDropdown
+ makeStoragePoolDropdown
makeSystemDropdown
+ makeTagsDropdown
makeTimeDropdown
makeTaskDropdown
setField
);
our @PREDEFINED_NOTIFICATIONS = (
+ 'Clearcase Storage',
+ 'Heartbeat',
'Loadavg',
'Filesystem',
'Scrub',
- 'Heartbeat',
'System checkin',
'Update systems',
);
our @PREDEFINED_TASKS = (
- 'Loadavg',
+ 'Clearcase Storage',
'Filesystem',
+ 'Loadavg',
'Scrub',
'System checkin',
'Update systems',
);
our @PREDEFINED_SCHEDULES = (
- 'Loadavg',
+ 'Clearcase Storage',
'Filesystem',
+ 'Loadavg',
'Scrub',
'Update systems',
);
my ($label, %rec) = @_;
$rec{$_} = setField ($rec{$_}, $label)
- foreach keys %rec;
+ for keys %rec;
return %rec;
} # setFields;
sub dumpVars (%) {
my (%vars) = @_;
- foreach (keys %vars) {
+ for (keys %vars) {
dbug "$_: $vars{$_}";
- } # foreach
+ } # for
return;
} # dumpVars
$values{All} = 'All';
$values{$$_{$name}} = $$_{$name}
- foreach ($clearadm->FindAlertlog);
+ for ($clearadm->FindAlertlog);
my $dropdown = popup_menu {
name => $name,
my %values;
- foreach (@values) {
+ for (@values) {
unless ($_ eq '') {
$values{$_} = $_;
} else {
$values{NULL} = '<NULL>';
} #if
- } # foreach
+ } # for
my $dropdown = popup_menu {
name => $name,
my @values;
push @values, $$_{name}
- foreach ($clearadm->FindAlert);
+ for ($clearadm->FindAlert);
my $dropdown = "$label ";
$dropdown .= popup_menu {
return $dropdown;
} # makeNoMorThanDropdown
+sub makeTagsDropdown($$) {
+ my ($type, $tag) = @_;
+
+ my $dropdown = ucfirst $type . ' ';
+
+ if ($type eq 'vob') {
+ my $vobs = Clearcase::Vobs->new;
+
+ $dropdown .= popup_menu {
+ name => 'tag',
+ class => 'dropdown',
+ values => [sort $vobs->vobs],
+ default => $tag,
+ };
+ } else {
+ my $views = Clearcase::Views->new;
+
+ $dropdown .= popup_menu {
+ name => 'tag',
+ class => 'dropdown',
+ values => [sort $views->views],
+ default => $tag,
+ };
+ } # if
+
+ return span {id => $type}, $dropdown;
+} # makeTagsDropdown
+
+sub makeStoragePoolDropdown($$) {
+ my ($type, $tag) = @_;
+
+ my @values;
+
+ my $dropdown = 'Storage pool ';
+
+ if ($type eq 'vob') {
+ push @values, qw(admin db cleartext derivedobj source total);
+ } else {
+ push @values, qw(admin db private total);
+ } # if
+
+ $dropdown .= popup_menu {
+ name => 'storage',
+ class => 'dropdown',
+ values => \@values,
+ default => $tag,
+ };
+
+ return span {id => $type}, $dropdown;
+} # makeStoragePoolsDropdown
+
sub makeFilesystemDropdown ($;$$$) {
my ($system, $label, $default, $onchange) = @_;
my %filesystems;
- foreach ($clearadm->FindFilesystem ($system)) {
+ for ($clearadm->FindFilesystem ($system)) {
my %filesystem = %{$_};
my $value = "$filesystem{filesystem} ($filesystem{mount})";
$filesystems{$filesystem{filesystem}} = $value;
- } # foreach
+ } # for
my $dropdown .= "$label ";
$dropdown .= popup_menu {
my @values;
push @values, $$_{name}
- foreach ($clearadm->FindNotification);
+ for ($clearadm->FindNotification);
my $dropdown = "$label ";
$dropdown .= popup_menu {
$label ||= '';
- foreach ($clearadm->FindSystem) {
+ for ($clearadm->FindSystem) {
my %system = %{$_};
my $value = $system{name};
$value .= $system{alias} ? " ($system{alias})" : '';
$systems{$system{name}} = $value;
- } # foreach
+ } # for
my $systemDropdown .= "$label ";
$systemDropdown .= popup_menu {
my @values;
push @values, $$_{name}
- foreach ($clearadm->FindTask);
+ for ($clearadm->FindTask);
my $taskDropdown = "$label ";
$taskDropdown .= popup_menu {
if ($table =~ /loadavg/i) {
push @times, $$_{timestamp}
- foreach ($clearadm->GetLoadavg ($system, undef, undef, undef, $interval));
+ for ($clearadm->GetLoadavg ($system, undef, undef, undef, $interval));
} elsif ($table =~ /filesystem/i) {
push @times, $$_{timestamp}
- foreach ($clearadm->GetFS ($system, $filesystem, undef, undef, undef, $interval));
+ for ($clearadm->GetFS ($system, $filesystem, undef, undef, undef, $interval));
} # if
push @times, 'Latest';
display start_li;
display a {href => 'systems.cgi'}, "Systems$ieTableWrapStart";
display start_ul;
- foreach (@allSystems) {
+ for (sort @allSystems) {
my %system = %{$_};
my $sysName = ucfirst $system{name};
$sysName .= " ($system{alias})"
display li a {
href => "systemdetails.cgi?system=$system{name}"
}, ucfirst " $sysName";
- } # foreach
+ } # for
display end_ul;
display $ieTableWrapEnd;
display end_li;
display start_li;
display a {href => 'filesystems.cgi'}, "Filesystems$ieTableWrapStart";
display start_ul;
- foreach (@allSystems) {
+ for (@allSystems) {
my %system = %{$_};
my $sysName = ucfirst $system{name};
$sysName .= " ($system{alias})"
display li a {
href => "filesystems.cgi?system=$system{name}"
}, ucfirst " $sysName";
- } # foreach
+ } # for
display end_ul;
display $ieTableWrapEnd;
display end_li;
display end_ul;
- # Servers
- display start_ul;
- display start_li;
- display a {href => '#'}, "Servers$ieTableWrapStart";
- display start_ul {class => 'skinny'};
- display start_li;
- display start_a {href => 'vobs.cgi'};
- display "<span class='drop'><span>VOB</span>»</span>$ieTableWrapStart";
- display start_ul;
- display li a {href => "systemdetails.cgi?system=jupiter"}, ' Jupiter (defaria.com)';
- display end_ul;
- display $ieTableWrapEnd;
- display end_li;
-
- display start_li;
- display start_a {href => 'views.cgi'};
- display "<span class='drop'><span>View</span>»</span>$ieTableWrapStart";
- display start_ul;
- display li a {href => "systemdetails.cgi?system=earth"}, ' Earth';
- display li a {href => "systemdetails.cgi?system=mars"}, ' Mars';
- display end_ul;
- display $ieTableWrapEnd;
- display end_ul;
- display $ieTableWrapEnd;
- display end_li;
- display end_ul;
-
# Vobs
display start_ul;
display start_li;
- display a {href => 'vobs.cgi'}, "VOBs$ieTableWrapStart";
- display start_ul;
- display li a {href => '#'}, ' /vobs/clearscm';
- display li a {href => '#'}, ' /vobs/clearadm';
- display li a {href => '#'}, ' /vobs/test';
- display li a {href => '#'}, ' /vobs/test2';
- display end_ul;
+ display a {href => 'vobservers.cgi'}, " VOBs$ieTableWrapStart";
display $ieTableWrapEnd;
display end_li;
display end_ul;
# Views
display start_ul;
display start_li;
- display a {href => 'views.cgi'}, "Views$ieTableWrapStart";
- display start_ul;
- display li a {href => 'viewager.cgi'}, ' View Ager';
- display li a {href => '#'}, ' Releast View';
- display end_ul;
+ display a {href => 'viewager.cgi'}, "Views$ieTableWrapStart";
display $ieTableWrapEnd;
display end_li;
display end_ul;
display th {class => 'labelCentered'}, 'Category';
display end_Tr;
- foreach ($clearadm->FindAlert ($alert)) {
+ for ($clearadm->FindAlert ($alert)) {
my %alert = %{$_};
$alert{who} = setField $alert{who}, 'System Administrator';
display td {class => 'data'},
(InArray $alert{name}, @PREDEFINED_ALERTS) ? 'Predefined' : 'User Defined';
display end_Tr;
- } # foreach
+ } # for
display end_table;
my $i = $opts{start};
- foreach ($clearadm->FindAlertlog (
+ for ($clearadm->FindAlertlog (
$opts{alert},
$opts{system},
$opts{notification},
}, $alertlog{runlog};
display td {class => 'data'}, $alertlog{message};
display end_Tr;
- } # foreach
+ } # for
display end_form;
display th {class => 'labelCentered'}, 'Usage';
display end_Tr;
- foreach ($clearadm->FindSystem ($systemName)) {
+ for (sort { $a->{mount} cmp $b->{mount} } $clearadm->FindSystem ($systemName)) {
my %system = %{$_};
%system = setFields ('N/A', %system);
? a {-href => "mailto:$system{email}"}, $system{admin}
: $system{admin};
- foreach ($clearadm->FindFilesystem ($system{name})) {
+ for ($clearadm->FindFilesystem ($system{name})) {
my %filesystem = %{$_};
my %fs = $clearadm->GetLatestFS ($system{name}, $filesystem{filesystem});
border => 0,
};
display end_Tr;
- } # foreach
- } # foreach
+ } # for
+ } # for
display end_table;
display th {class => 'labelCentered'}, 'Category';
display end_Tr;
- foreach ($clearadm->FindNotification ($notification)) {
+ for ($clearadm->FindNotification ($notification)) {
my %notification= setFields 'N/A', %{$_};
display start_Tr;
: 'User Defined';
display end_Tr;
- } # foreach
+ } # for
display end_table;
my $optsChanged;
- unless (($opts{oldtask} and $opts{task} or
- $opts{oldtask} eq $opts{task}) and
- ($opts{oldsystem} and $opts{system} or
- $opts{oldsystem} eq $opts{system}) and
- ($opts{oldnot} and $opts{not} or
- $opts{oldnot} eq $opts{not}) and
- ($opts{oldstatus} and $opts{status} or
- $opts{oldstatus} eq $opts{status})) {
- $optsChanged = 1;
- } # unless
+ for (qw(task system not status)) {
+ my $old = "old$_";
+ if (($opts{$old} and $opts{$_}) and ($opts{$old} ne $opts{$_})) {
+ $optsChanged = 1;
+ last;
+ } # if
+ } # for
- my $condition;
+ my $condition = '';
unless ($opts{id}) {
- $condition = "task like '%";
- $condition .= $opts{task} ? $opts{task} : '';
- $condition .= "%'";
+ if ($opts{task} !~ /all/i) {
+ $condition = "task like '%";
+ $condition .= $opts{task} ? $opts{task} : '';
+ $condition .= "%'";
+ } # if
- if ($opts{system}) {
+ if ($opts{system} !~ /all/i) {
if ($opts{system} eq '<NULL>') {
$condition .= ' and system is null';
undef $opts{system}
} # if
} # if
- if (defined $opts{status}) {
+ if ($opts{status} !~ /all/i) {
$condition .= ' and ';
unless ($opts{not}) {
$condition .= "status=$opts{status}";
my $status;
- if (defined $opts{status}) {
+ if ($opts{status}) {
if ($opts{status} !~ /all/i) {
$status = $opts{not} ne 'true' ? $opts{status} : "!$opts{status}";
} # if
} # if
- foreach ($clearadm->FindRunlog (
+ for ($clearadm->FindRunlog (
$opts{task},
$opts{system},
$status,
display td {class => 'data'}, a {
href => "tasks.cgi?task=$runlog{task}"
}, $runlog{task};
- display td {class => 'data'}, $runlog{system} eq 'Localhost'
+ display td {class => 'data'}, $runlog{system} eq 'localhost'
? $runlog{system}
: a {
href => "systemdetails.cgi?system=$runlog{system}"
display td {class => $class, width => '50%'}, $message;
display end_Tr;
- } # foreach
+ } # for
display end_table;
display th {class => 'labelCentered'}, 'Category';
display end_Tr;
- foreach ($clearadm->FindSchedule) {
+ for ($clearadm->FindSchedule) {
my %schedule = setFields 'N/A', %{$_};
display start_Tr;
: 'User Defined';
display end_Tr;
- } # foreach
+ } # for
display end_table;
display th {class => 'labelCentered'}, 'Usage';
display end_Tr;
- foreach ($clearadm->FindFilesystem ($system{name})) {
+ for ($clearadm->FindFilesystem ($system{name})) {
my %filesystem = %{$_};
my %fs = $clearadm->GetLatestFS (
border => 0,
};
display end_Tr;
- } # foreach
+ } # for
display end_table;
display th {class => 'labelCentered'}, 'Category';
display end_Tr;
- foreach ($clearadm->FindTask ($task)) {
+ for ($clearadm->FindTask ($task)) {
my %task = %{$_};
$task{system} = 'All Systems'
display td {class => 'data'},
(InArray $task{name}, @PREDEFINED_TASKS) ? 'Predefined' : 'User Defined';
display end_Tr;
- } # foreach
+ } # for
display end_table;
};
my $systemDropdown = makeSystemDropdown (
undef,
- $task{system} ? $task{system} : 'All Systems',
+ $task{system} ? $task{system} : 'localhost',
undef, (
- 'All systems' => undef,
- 'Localhost' => 'Localhost',
+ 'localhost' => 'localhost',
),
);
use warnings;
use Carp;
-use Net::LDAP;
+#use Net::LDAP;
use GetConfig;
on update cascade
) engine=innodb; -- 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),
+
+ key vobtagIndex (tag),
+ primary key (tag, region, timestamp)
+) engine=innodb; -- vobstorage
+
+-- viewstorage: Contains a snapshot of a view's storage pools at a given date
+-- and time
+create table viewstorage (
+ tag varchar(255) not null,
+ region varchar(255) not null,
+ timestamp datetime not null,
+ private decimal(10,1),
+ db decimal(10,1),
+ admin decimal(10,1),
+ total decimal(10,1),
+
+ key viewtagIndex (tag),
+ primary key (tag, region, timestamp)
+) engine=innodb; -- viewstorage
+
-- loadavg: Contains a snapshot reading of a system's load average
create table loadavg (
system varchar(255) not null,
'Once a day'
);
+insert into notification (
+ name,
+ alert,
+ cond,
+ nomorethan
+) values (
+ 'Clearcase Storage',
+ 'Email admin',
+ 'Clearcase Failure',
+ 'Once a day'
+);
+
insert into notification (
name,
alert,
command
) values (
'Loadavg',
- 'Localhost',
+ 'localhost',
'Obtain a loadavg snapshot on all systems',
'updatela.pl'
);
command
) values (
'Filesystem',
- 'Localhost',
+ 'localhost',
'Obtain a filesystem snapshot on all systems/filesystems',
'updatefs.pl'
);
command
) values (
'Scrub',
- 'Localhost',
+ 'localhost',
'Scrub Clearadm database',
'clearadmscrub.pl'
);
command
) values (
'System checkin',
- 'Localhost',
+ 'localhost',
'Checkin from all systems',
'default'
);
command
) values (
'Update systems',
- 'Localhost',
+ 'localhost',
'Update all systems',
'updatesystem.pl -host all'
);
+insert into task (
+ name,
+ system,
+ description,
+ command
+) values (
+ 'Clearcase Storage',
+ 'localhost',
+ 'Update Clearcase VOB/View storage',
+ 'updateccfs.pl'
+);
+
-- Predefined schedule
insert into schedule (
name,
'Scrub',
'1 day'
);
+
+insert into schedule (
+ name,
+ task,
+ notification,
+ frequency
+) values (
+ 'Clearcase Storage',
+ 'Clearcase Storage',
+ 'Clearcase Storage',
+ '1 day'
+);
+
+
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
sub displayGraph () {
my $parms;
- foreach (keys %opts) {
- $parms .= '&'
- if $parms;
+ for (keys %opts) {
+ $parms .= '&' if $parms;
$parms .= "$_=$opts{$_}"
- } # foreach
+ } # for
display '<center>';
if ($opts{type} eq 'loadavg') {
- unless ($opts{tiny}) {
+ unless ($opts{tiny}) {
display img {src => "plotloadavg.cgi?$parms", class => 'chart'};
- } else {
+ } else {
display img {src => "plotloadavg.cgi?$parms", border => 0};
- } # unless
+ } # unless
} elsif ($opts{type} eq 'filesystem') {
- unless ($opts{tiny}) {
+ unless ($opts{tiny}) {
display img {src => "plotfs.cgi?$parms", class => 'chart'};
- } else {
+ } else {
display img {src => "plotfs.cgi?$parms", border => 0};
- } # unless
+ } # unless
+ } elsif ($opts{type} eq 'vob' or $opts{type} eq 'view') {
+ unless ($opts{tiny}) {
+ display img {src => "plotstorage.cgi?$parms", class => 'chart'};
+ } else {
+ display img {src => "plotstorage.cgi?$parms", border => 0};
+ } # unless
} # if
display '</center>';
return;
} # displayInfo
-sub displayControls () {
+sub displayControls() {
my $class = $opts{type} =~ /loadavg/i
? 'controls'
: 'filesystemControls';
width => '800px',
};
- my $systemLink = span {id => 'systemLink'}, a {
- href => "systemdetails.cgi?system=$opts{system}",
- }, 'System';
+ my $tagsButtons;
+ my ($systemLink, $systemButtons);
- my $systemButtons = makeSystemDropdown (
- $systemLink,
- $opts{system},
- 'updateFilesystems(this.value);updateSystemLink(this.value)'
- );
+ if ($opts{type} =~ /(vob|view)/i) {
+ $tagsButtons = makeTagsDropdown ($opts{type}, $opts{tag});
+ } else {
+ $systemLink = span {id => 'systemLink'}, a {
+ href => "systemdetails.cgi?system=$opts{system}",
+ }, 'System';
+
+ $systemButtons = makeSystemDropdown (
+ $systemLink,
+ $opts{system},
+ 'updateFilesystems(this.value);updateSystemLink(this.value)'
+ );
+ } # if
my $startButtons = makeTimeDropdown (
$opts{type},
$opts{scaling},
);
- my $update = $opts{type} eq 'loadavg'
- ? "updateSystem('$opts{system}')"
- : "updateFilesystem('$opts{system}','$opts{filesystem}')";
+ my $update;
+
+ if ($opts{type} eq 'loadavg') {
+ $update = "updateSystem('$opts{system}')";
+ } elsif ($opts{type} eq 'filsystem') {
+ $update = "updateFilesystem('$opts{system}','$opts{filesystem}')";
+ } else {
+ $update = ''; # TODO do I need something here?
+ } # if
my $intervalButtons = makeIntervalDropdown (
'Interval',
display start_Tr;
display td $startButtons;
display td $intervalButtons;
- display td $systemButtons;
+ display td $opts{type} =~ /(vob|view)/i ? $tagsButtons : $systemButtons;
display end_Tr;
display start_Tr;
value => 'Draw Graph',
};
} else {
- my $filesystemButtons = makeFilesystemDropdown (
- $opts{system},
- 'Filesystem',
- undef,
- "updateFilesystem('$opts{system}',this.value)",
- );
+ if ($opts{type} eq 'filesystem') {
+ my $filesystemButtons = makeFilesystemDropdown (
+ $opts{system},
+ 'Filesystem',
+ undef,
+ "updateFilesystem('$opts{system}',this.value)",
+ );
- display td $filesystemButtons;
+ display td $filesystemButtons;
+ } else {
+ my $storagePoolButtons = makeStoragePoolDropdown ($opts{type}, $opts{tag});
+
+ display td $storagePoolButtons;
+ } # if
display end_Tr;
display start_Tr;
$clearadm = Clearadm->new;
-my $title = ucfirst ($opts{type}) . ': ' . ucfirst $opts{system};
+my $title = ucfirst ($opts{type}) . ': ';
-$title .= ":$opts{filesystem}"
- if $opts{filesystem};
+$title .= ucfirst $opts{system} if $opts{system};
+$title .= ":$opts{filesystem}" if $opts{filesystem};
+$title .= $opts{tag} if $opts{tag};
+$title .= " Storage pool: $opts{storage}" if $opts{storage};
heading $title;
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
$opts{scaling}
);
-graphError "No loadavg data found for system $opts{system}"
+graphError "No loadavg data"
unless @loads;
my (@x, @y);
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
--- /dev/null
+#!/usr/local/bin/perl
+
+=pod
+
+=head1 NAME $RCSfile: plotstorage.cgi,v $
+
+Plot Clearcse Storage usage
+
+=head1 VERSION
+
+=over
+
+=item Author
+
+Andrew DeFaria <Andrew@ClearSCM.com>
+
+=item Revision
+
+$Revision: 1.13 $
+
+=item Created:
+
+Mon Dec 13 09:13:27 EST 2010
+
+=item Modified:
+
+$Date: 2011/01/14 16:37:04 $
+
+=back
+
+=head1 SYNOPSIS
+
+ Usage plotstorage.cgi: tag=<tag> type=<vob|view> storage=<storage>
+ [height=<height>] [width=<width>] [color=<color>]
+ [scaling=<scaling>] [points=<points>] [tiny=<0|1>]
+
+ Where:
+ <tag>: Tag of the Clearcase object (vob or view)
+ <type>: Designates whether <tag> is a vob of a view
+ <storage>: Name of the Clearcase storage pool to plot information for
+ <height>: Height of chart (Default: 480px - tiny: 40)
+ <width>: Width of chart (Default: 800px - tiny: 150)
+ <color>: A GD::Color color value (Default: lblue)
+ <scaling>: Currently one of Minute, Hour, Day or Month. Specifies how
+ Clearadm::GetFS will scale the data returned (Default: Minute
+ - tiny: Day)
+ <points>: Number of points to plot (Default: all points - tiny: 7)
+
+=head1 DESCRIPTION
+
+Draws a chart of the storage usage for the Clearcase object (vob|view).
+Parameters such as height, width, color, scaling and points can be set
+individually though more often the user will just use the web controls to set
+them. Defaults produce a nice chart. Tiny mode is used by
+<vob|view>details.cgi to draw tiny charts in the table. Setting tiny sets
+a number of the other chart options to produce a standard, tiny chart.
+
+=cut
+
+use strict;
+use warnings;
+
+use FindBin;
+
+use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib";
+
+use Clearadm;
+use ClearadmWeb;
+use Clearcase;
+use Display;
+
+use CGI qw (:standard :cgi-lib);
+use GD::Graph::area;
+
+my %opts = Vars;
+
+my $VERSION = '$Revision: 1.13 $';
+ ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
+
+$opts{color} ||= 'lblue';
+$opts{height} ||= 350;
+$opts{width} ||= 800;
+
+if ($opts{tiny}) {
+ $opts{height} = 40;
+ $opts{width} = 150;
+ $opts{points} = 7;
+ $opts{scaling} = 'Day';
+} # if
+
+my $clearadm = Clearadm->new;
+
+my $graph = GD::Graph::area->new ($opts{width}, $opts{height});
+
+graphError "Tag is required" unless $opts{tag};
+graphError "Type is required" unless $opts{type};
+graphError "Storage is required" unless $opts{storage};
+
+graphError "Points not numeric (points: $opts{points})"
+ if $opts{points} and $opts{points} !~ /^\d+$/;
+
+my @storage = $clearadm->GetStorage (
+ $opts{type},
+ $opts{tag},
+ $opts{storage},
+ $opts{region},
+ $opts{start},
+ $opts{end},
+ $opts{points},
+ $opts{scaling}
+);
+
+graphError "No data found for $opts{type} $opts{tag} for storage pool $opts{storage}"
+ unless @storage;
+
+my (@x, @y);
+
+my $i = 0;
+
+for (@storage) {
+ $i++;
+ my %storage = %{$_};
+
+ if ($opts{tiny}) {
+ push @x, '';
+ } else {
+ push @x, $storage{timestamp};
+ } # if
+
+ push @y, $opts{meg} ? $storage{size} / (1024 * 1024) :
+ $storage{size} / (1024 * 1024 * 12024);
+} # for
+
+my @data = ([@x], [@y]);
+
+my $x_label_skip = @x > 1000 ? 200
+ : @x > 100 ? 20
+ : @x > 50 ? 2
+ : @x > 10 ? 1
+ : 0;
+
+my $storageLabel = ucfirst $opts{storage};
+my $x_label = $opts{tiny} ? '' : "$storageLabel Storage";
+my $y_label = $opts{tiny} ? '' :
+ $opts{msg} ? 'Used (Meg)' : 'Used (Gig)';
+my $title = $opts{tiny} ? '' : "Storage usage for "
+ . "$opts{type}:$opts{tag} $storageLabel";
+my $labelY = $opts{tiny} ? '' : '%.2f';
+
+$graph->set (
+ x_label => $x_label,
+ x_labels_vertical => 1,
+ x_label_skip => $x_label_skip,
+ x_label_position => .5,
+ y_label => $y_label,
+ y_number_format => $labelY,
+ title => $title,
+ dclrs => [$opts{color}],
+ bgclr => 'white',
+ transparent => 0,
+ long_ticks => 1,
+ t_margin => 5,
+ b_margin => 5,
+ l_margin => 5,
+ r_margin => 5,
+) or graphError $graph->error;
+
+my $image = $graph->plot(\@data)
+ or croak $graph->error;
+
+print "Content-type: image/png\n\n";
+print $image->png;
+
+=pod
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+DEBUG: If set then $debug is set to this level.
+
+VERBOSE: If set then $verbose is set to this level.
+
+TRACE: If set then $trace is set to this level.
+
+=head1 DEPENDENCIES
+
+=head2 Perl Modules
+
+L<CGI>
+
+L<FindBin>
+
+L<Getopt::Long|Getopt::Long>
+
+L<GD::Graph::area|GD::Graph::area>
+
+=head2 ClearSCM Perl Modules
+
+=begin man
+
+ Clearadm
+ ClearadmWeb
+ Display
+
+=end man
+
+=begin html
+
+<blockquote>
+<a href="http://clearscm.com/php/scm_man.php?file=clearadm/lib/Clearadm.pm">Clearadm</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=clearadm/lib/ClearadmWeb.pm">ClearadmWeb</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Display.pm">Display</a><br>
+</blockquote>
+
+=end html
+
+=head1 BUGS AND LIMITATIONS
+
+There are no known bugs in this script
+
+Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
+
+=cut
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/bin/env perl
=pod
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
heading $title;
-unless ($opts{'delete.x'} or $opts{'edit.x'} or $opts{action} eq 'Post') {
+unless ($opts{'delete.x'}
+ or $opts{'edit.x'}
+ or $opts{action} eq 'Post'
+ or $opts{action} eq 'Add'
+ ) {
displayError 'Action not defined!';
exit 1;
} # unless
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
heading $title;
-undef $opts{task}
- if $opts{task} and $opts{task} eq 'All';
-
+$opts{task} ||= 'All';
$opts{system} ||= 'All';
+$opts{not} ||= 0;
+$opts{status} ||= 'All';
-undef $opts{status}
- if $opts{status} and $opts{status} eq 'All';
-
display h1 {class => 'center'}, $title;
displayRunlog (%opts);
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/bin/env perl
=pod
my ($status, @output, $cmd);
- if ($ARCH eq 'cygwin') {
+ if ($ARCHITECTURE eq 'cygwin') {
verbose '[Cygwin] Creating up Clearagent Service';
$cmd = 'cygrunsrv -I clearagent -p C:/Cygwin/bin/perl ';
($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join ("\n", @output), 1
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
if $status;
verbose '[Cygwin] Starting Clearagent Service';
$cmd .= 'net start clearagent';
($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join ("\n", @output), 1
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
if $status;
} else {
- my $Arch = ucfirst $ARCH;
+ my $Arch = ucfirst $ARCHITECTURE;
verbose 'Creating clearagent user';
$cmd = 'useradd -Mr clearagent';
+ $cmd = 'useradd clearagent' if $ARCHITECTURE eq 'solaris';
($status, @output) = Execute "$cmd 2>&1";
if ($status == 9) {
warning "The user clearagent already exists";
+ } elsif ($status == 2304) {
+ # Stupid Solaris...
} elsif ($status != 0) {
- error "Unable to execute $cmd (Status: $status)\n" . join ("\n", @output), 1;
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status;
} # if
verbose 'Setting permissions on log and var directories';
-
- $cmd = "chmod 777 $Clearadm::CLEAROPTS{CLEARADM_BASE}/var;";
- $cmd .= "chmod 777 $Clearadm::CLEAROPTS{CLEARADM_BASE}/var/run;";
- $cmd .= "chmod 777 $Clearadm::CLEAROPTS{CLEARADM_BASE}/log";
-
- ($status, @output) = Execute "$cmd 2>&1";
-
- error "Unable to execute $cmd (Status: $status)\n" . join ("\n", @output), 1
- if $status;
+ for (qw(var var/run log)) {
+ $cmd = "mkdir -p $Clearadm::CLEAROPTS{CLEARADM_BASE}/$_";
+
+ ($status, @output) = Execute "$cmd 2>&1";
+
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
+ if $status;
+
+ $cmd = "chmod 777 $Clearadm::CLEAROPTS{CLEARADM_BASE}/$_";
+
+ ($status, @output) = Execute "$cmd 2>&1";
+
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
+ if $status;
+ } # for
+
verbose "[$Arch] Setting up clearagent daemon";
# Symlink $CLEARADM/etc/conf.d/clearadm -> /etc/init.d
error "Cannot find conf.d directory ($confdir)", 1
unless -d $confdir;
- unless (-e "$confdir/clearadm") {
- $cmd = "ln -s $FindBin::Bin/etc/init.d/clearadm $confdir";
+ unless (-e "$confdir/clearagent") {
+ $cmd = "ln -s $FindBin::Bin/etc/init.d/clearagent $confdir";
($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join ("\n", @output), 1
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
if $status;
} # unless
# Setup runlevel links
- $cmd = 'update-rc.d clearagent defaults';
+ if ($ARCHITECTURE eq 'solaris') {
+ $cmd = "ln -s /etc/init.d/clearagent /etc/rc2.d/S90clearagent";
+
+ ($status, @output) = Execute "$cmd 2>&1";
+
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
+ if $status;
+
+ verbose 'Starting clearagent';
- ($status, @output) = Execute "$cmd 2>&1";
+ $cmd = '/etc/init.d/clearagent';
+
+ ($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join ("\n", @output), 1
- if $status;
-
- verbose 'Starting clearagent';
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
+ if $status;
+ } else {
+ $cmd = 'update-rc.d clearagent defaults';
- $cmd = 'service clearagent start';
+ ($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join ("\n", @output), 1
- if $status;
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
+ if $status;
+
+ verbose 'Starting clearagent';
+
+ $cmd = 'service clearagent start';
+
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
+ if $status;
+ } # if
} # if
verbose "Done";
($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join ("\n", @output), 1
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
if $status;
} # unless
($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join ("\n", @output), 1
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
if $status;
verbose 'Starting cleartasks';
($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join ("\n", @output), 1
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
if $status;
verbose 'Done';
($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join ("\n", @output), 1
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
if $status;
} # unless
- if ($ARCH eq 'cygwin') {
+ if ($ARCHITECTURE eq 'cygwin') {
$cmd = 'net stop apache2; net start apache2';
} else {
$cmd = '/etc/init.d/apache2 restart';
($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join ("\n", @output), 1
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
if $status;
verbose 'Done';
($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join ("\n", @output), 1
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
if $status;
verbose 'Setting up database users';
($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join ("\n", @output), 1
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
if $status;
verbose 'Setting up predefined tasks';
($status, @output) = Execute "$cmd 2>&1";
- error "Unable to execute $cmd (Status: $status)\n" . join ("\n", @output), 1
+ error "Unable to execute $cmd (Status: $status)\n" . join("\n", @output), $status
if $status;
verbose 'Done';
# Main
error "Cannot setup Clearadm when using Windows - hint try using Cgywin", 1
- if $ARCH eq 'windows';
+ if $ARCHITECTURE eq 'windows';
Usage 'You must be root'
- unless $> == 0 or $ARCH eq 'cygwin';
+ unless $> == 0 or $ARCHITECTURE eq 'cygwin';
my $package = 'all';
SetupWeb;
} # if
-=pod
\ No newline at end of file
+=pod
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/bin/env perl
use strict;
use warnings;
error $msg, $err
if $err;
-
\ No newline at end of file
+
--- /dev/null
+#!/usr/local/bin/perl
+
+=pod
+
+=head1 NAME $RCSfile: updateccstorage.pl,v $
+
+Update Filesystem
+
+=head1 VERSION
+
+=over
+
+=item Author
+
+Andrew DeFaria <Andrew@ClearSCM.com>
+
+=item Revision
+
+$Revision: 1.29 $
+
+=item Created:
+
+Mon Dec 13 09:13:27 EST 2010
+
+=item Modified:
+
+$Date: 2011/06/16 15:12:50 $
+
+=back
+
+=head1 SYNOPSIS
+
+ Usage updateccstorage.pl: [-u|sage] [-ve|rbose] [-deb|ug]
+ [-view [<tag>|all]| -vob [<tag>|all]]
+
+ Where:
+ -u|sage: Displays usage
+
+ -ve|rbose: Be verbose
+ -deb|ug: Output debug messages
+
+ -view [<tag>|all] Update view storage (Default: all)
+ -vob [<tag>|all] Update vob storage (Default: all)
+ -region [<region>|all] Update region (Default: all)
+
+=head1 DESCRIPTION
+
+This script will record the state of Clearcase storage
+
+=cut
+
+use strict;
+use warnings;
+
+use FindBin;
+use Getopt::Long;
+
+use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib";
+
+use Clearadm;
+use Clearexec;
+use Clearcase::Views;
+use Clearcase::View;
+use Clearcase::Vobs;
+use Clearcase::Vob;
+use DateUtils;
+use Display;
+use Utils;
+
+my $VERSION = '$Revision: 1.29 $';
+ ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
+
+my $clearadm = Clearadm->new;
+
+# Given a view tag, snapshot the storage sizes
+sub snapshotViewStorage($$) {
+ my ($tag, $region) = @_;
+
+ my %viewstorage = (
+ tag => $tag,
+ region => $region,
+ );
+
+ my $view = Clearcase::View->new($tag, $region);
+
+ $viewstorage{private} = $view->viewPrivateStorage;
+ $viewstorage{db} = $view->viewDatabase;
+ $viewstorage{admin} = $view->viewAdmin;
+ $viewstorage{total} = $view->viewSpace;
+
+ my ($err, $msg) = $clearadm->AddViewStorage(%viewstorage);
+
+ error $msg, $err if $err;
+} # snapshotVobStorage
+
+# Given a vob tag, snapshot the storage sizes
+sub snapshotVobStorage($$) {
+ my ($tag, $region) = @_;
+
+ my %vobstorage = (
+ tag => $tag,
+ region => $region,
+ );
+
+ my $vob = Clearcase::Vob->new($tag, $region);
+
+ $vobstorage{admin} = $vob->admsize;
+ $vobstorage{db} = $vob->dbsize;
+ $vobstorage{cleartext} = $vob->ctsize;
+ $vobstorage{derivedobj} = $vob->dosize;
+ $vobstorage{source} = $vob->srcsize;
+ $vobstorage{total} = $vob->size;
+
+ my ($err, $msg) = $clearadm->AddVobStorage(%vobstorage);
+
+ error $msg, $err, if $err;
+} # snapshotVobStorage
+
+my %opts;
+
+# Main
+GetOptions (
+ \%opts,
+ 'usage' => sub { Usage },
+ 'verbose' => sub { set_verbose },
+ 'debug' => sub { set_debug },
+ 'view=s',
+ 'vob=s',
+ 'region=s',
+) or Usage "Invalid parameter";
+
+Usage 'Extraneous options: ' . join ' ', @ARGV if @ARGV;
+
+unless ($opts{view} or $opts{vob}) {
+ $opts{view} = 'all';
+ $opts{vob} = 'all';
+} # unless
+
+$opts{region} ||= 'all';
+
+# Announce ourselves
+verbose "$FindBin::Script V$VERSION";
+
+if ($opts{view} and $opts{view} =~ /all/i) {
+ if ($opts{region} =~ /all/i) {
+ for my $region ($Clearcase::CC->regions) {
+ my $views = Clearcase::Views->new($region);
+
+ for my $view ($views->views) {
+ verbose "Snapshotting view $view in region $region";
+
+ snapshotViewStorage $view, $region;
+ } # for
+ } # for
+ } else {
+ my $views = Clearcase::Views->new($opts{region});
+
+ for my $view ($views->views) {
+ verbose "Snapshotting view $view in region $opts{region}";
+
+ snapshotViewStorage $view, $opts{region};
+ } # for
+ } # if
+} elsif ($opts{view}) {
+ if ($opts{region} =~ /all/i) {
+ for my $region ($Clearcase::CC->regions) {
+ verbose "Snapshotting view $opts{view} in region $region";
+
+ snapshotViewStorage $opts{view}, $region;
+ } # for
+ } else {
+ verbose "Snapshotting view $opts{view} in region $opts{region}";
+
+ snapshotViewStorage $opts{view}, $opts{region};
+ } # if
+} # if
+
+if ($opts{vob} and $opts{vob} =~ /all/i) {
+ if ($opts{region} =~ /all/i) {
+ for my $region ($Clearcase::CC->regions) {
+ my $vobs = Clearcase::Vobs->new(undef, $region);
+
+ for my $vob ($vobs->vobs) {
+ verbose "Snapshotting vob $vob in region $region";
+
+ snapshotVobStorage $vob, $region;
+ } # for
+ } # for
+ } else {
+ my $vobs = Clearcase::Vobs->new(undef, $opts{region});
+
+ for my $vob ($vobs->vobs) {
+ verbose "Snapshotting vob $vob in region $opts{region}";
+
+ snapshotVobStorage $vob, $opts{region};
+ } # for
+ } # if
+} elsif ($opts{vob}) {
+ if ($opts{region} =~ /all/i) {
+ for my $region ($Clearcase::CC->regions) {
+ verbose "Snapshotting view $opts{vob} in region $region";
+
+ snapshotVobStorage $opts{vob}, $region;
+ } # for
+ } else {
+ verbose "Snapshotting vob $opts{vob} in region $opts{region}";
+
+ snapshotVobStorage $opts{vob}, $opts{region};
+ } # if
+} # if
+
+=pod
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+DEBUG: If set then $debug is set to this level.
+
+VERBOSE: If set then $verbose is set to this level.
+
+TRACE: If set then $trace is set to this level.
+
+=head1 DEPENDENCIES
+
+=head2 Perl Modules
+
+L<FindBin>
+
+L<Getopt::Long|Getopt::Long>
+
+L<Net::Domain|Net::Domain>
+
+=head2 ClearSCM Perl Modules
+
+=begin man
+
+ Clearadm
+ Clearexec
+ DateUtils
+ Display
+ Utils
+
+=end man
+
+=begin html
+
+<blockquote>
+<a href="http://clearscm.com/php/scm_man.php?file=clearadm/lib/Clearadm.pm">Clearadm</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=clearadm/lib/Clearcase/Vobs.pm">Clearcase::Vobs</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=clearadm/lib/Clearcase/Vobs.pm">Clearcase::Vob</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=clearadm/lib/Clearcase/Views.pm">Clearcase::Views</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=clearadm/lib/Clearcase/View.pm">Clearcase::View</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/DateUtils.pm">DateUtils</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Display.pm">Display</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Utils.pm">Utils</a><br>
+</blockquote>
+
+=end html
+
+=head1 BUGS AND LIMITATIONS
+
+There are no known bugs in this script
+
+Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
+
+=cut
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
# Sun is so braindead!
# TODO: Verify this works under Solaris
if ($system{type} eq 'Unix') {
- foreach ('ufs', 'vxfs') {
- my $cmd = "/usr/bin/df -k -F $filesystem{mount}";
+ my $cmd = "df -v $filesystem{mount}";
- my ($status, @unixfs) = $clearexec->execute ($cmd);
+ my ($status, @unixfs) = $clearexec->execute ($cmd);
- if ($status != 0) {
- error ('Unable to determine fsinfo for '
- . "$system{name}:$filesystem{mount} ($cmd)\n" .
- join "\n", @unixfs
- );
-
- return;
- } # if
+ if ($status != 0) {
+ error ('Unable to determine fsinfo for '
+ . "$system{name}:$filesystem{mount} ($cmd)\n" .
+ join "\n", @unixfs);
+
+ return;
+ } # if
- # Skip heading
- shift @unixfs;
+ # Skip heading
+ shift @unixfs;
- for (my $i = 0; $i < scalar @unixfs; $i++) {
- my $firstField;
-
- # Trim leading and trailing spaces
- $unixfs[$i] =~ s/^\s+//;
- $unixfs[$i] =~ s/\s+$//;
-
- my @fields = split /\s+/, $unixfs[$i];
-
- if (@fields == 1) {
- $firstField = 0;
- $i++;
-
- @fields = split /\s+/, $unixfs[$i];;
- } else {
- $firstField = 1;
- } #if
-
- $fs{size} = $fields[$firstField] * 1024;
- $fs{used} = $fields[$firstField + 1] * 1024;
- $fs{free} = $fields[$firstField + 2] * 1024;
- $fs{reserve} = $fs{size} - $fs{used} - $fs{free};
- } # for
- } # foreach
+ for (my $i = 0; $i < scalar @unixfs; $i++) {
+ my @fields = split ' ', $unixfs[$i];
+
+ $fs{mount} = $fields[0];
+ $fs{size} = $fields[2] * 1024;
+ $fs{used} = $fields[3] * 1024;
+ $fs{free} = $fields[4] * 1024;
+ $fs{reserve} = $fs{size} - $fs{used} - $fs{free};
+ } # for
} elsif ($system{type} eq 'Linux' or $system{type} eq 'Windows') {
my $cmd = "/bin/df --block-size=1 -P $filesystem{mount}";
my $exit = 0;
-foreach my $system ($clearadm->FindSystem ($host)) {
+for my $system ($clearadm->FindSystem ($host)) {
next if $$system{active} eq 'false';
my $status = $clearexec->connectToServer (
next;
} # unless
- foreach my $filesystem ($clearadm->FindFilesystem ($$system{name}, $fs)) {
+ for my $filesystem ($clearadm->FindFilesystem ($$system{name}, $fs)) {
verbose "Snapshotting $$system{name}:$$filesystem{filesystem}";
my %fs = snapshotFS ($system, $$filesystem{filesystem});
next
unless %notification;
- my $usedPct = sprintf (
- '%.2f',
- (($fs{used} + $fs{reserve}) / $fs{size}) * 100
- );
+ my $usedPct = '0%';
+
+ $usedPct = sprintf ('%.2f', (($fs{used} + $fs{reserve}) / $fs{size}) * 100) if $fs{size} != 0;
if ($usedPct >= $$filesystem{threshold}) {
$exit = 2;
- display YMDHMS . " System: $$filesystem{system} "
+ display YMDHMS
+ . " System: $$filesystem{system} "
. "Filesystem: $$filesystem{filesystem} Used: $usedPct% "
. "Threshold: $$filesystem{threshold}";
} else {
$clearadm->ClearNotifications ($$system{name}, $$filesystem{filesystem});
} # if
- } # foreach
+ } # for
$clearexec->disconnectFromServer;
-} # foreach
+} # for
exit $exit;
-#!/usr/bin/perl
+#!/usr/bin/env perl
=pod
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/bin/env perl
=pod
my ($delete, $host, $port);
-sub GetFilesystems (%) {
+sub GetFilesystems(%) {
my (%system) = @_;
# TODO: Unix/Linux systems often vary as to what parameters df supports. The
# -P is to intended to make this POSIX standard. Need to make sure this works
# on other systems (i.e. Solaris, HP-UX, Redhat, etc.).
- my $cmd = $system{type} eq 'Windows' ? 'df -TP' : 'df -l -TP';
+ my $cmd = $system{type} eq 'Windows'
+ ? 'df -TP'
+ : $system{type} eq 'Unix' # I think I need to add a Solaris type
+ ? '/usr/xpg4/bin/df -l -P'
+ : 'df -l -TP';
my ($status, @output) = $clearexec->execute ($cmd);
- error "Unable to execute uname -a - $!", $status . join ("\n". @output)
+ error "Unable to execute $cmd - $! (Status: $status)\n" . join ("\n". @output), $status
if $status;
# Real file systems start with "/"
- @output = grep { /^\// } @output;
+ my @fs = grep { /^\// } @output;
+
+ # Also add lines that start with rpool (This is for Solaris zones
+ push @fs, grep { /^rpool/ } @output;
my @filesystems;
- foreach (@output) {
- if (/^(\S+)\s+(\S+).+?(\S+)$/) {
+ for (@fs) {
+ if (/^(\S+)\s+(\S+).+?(\S+)$/) {
my %filesystem;
$filesystem{system} = $system{name};
- $filesystem{filesystem} = $1;
- $filesystem{fstype} = $2;
- $filesystem{mount} = $3;
+ $filesystem{filesystem} = $1;
+ $filesystem{fstype} = $2;
+ $filesystem{mount} = $3;
push @filesystems, \%filesystem;
- } # if
- } # foreach
+ } # if
+ } # for
return @filesystems;
} # GetFilesystems
if $status;
# TODO: Need to handle this better
- $system{type} = $output[0] =~ /cygwin/i ? 'Windows' : $output[0];
+ if ($output[0] =~ /sunos/i) {
+ $system{type} = 'Unix';
+ } elsif ($output[0] =~ /cygwin/i) {
+ $system{type} = 'Windows';
+ } else {
+ $system{type} = 'Linux';
+ } # if
return %system;
} # GatherSysInfo
my ($err, $msg);
- foreach (GetFilesystems %system) {
+ for (GetFilesystems %system) {
my %filesystem = %{$_};
my %oldfilesystem = $clearadm->GetFilesystem (
. "$filesystem{system}:$filesystem{filesystem}"
if $err;
} # if
- } # foreach
+ } # for
return ($err, $msg);
} # AddFilesystems
} # if
} else {
if ($host eq 'all') {
- foreach ($clearadm->FindSystem) {
+ for ($clearadm->FindSystem) {
my %system = %$_;
($err, $msg) = UpdateSystem (%system);
error "Unable to update host $system{name}\n$msg", $err
if $err;
- } # foreach
+ } # for
} else {
my %system = $clearadm->GetSystem ($host);
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
Where:
-u|sage: Displays usage
- -region <region>: Region to use when looking for the view
+ -region <region>: Region to use when looking for views (Default
+ for generate action: all)
-e|mail: Send email to owners of old views
-ag|eThreshold: Number of days before a view is considered old
(Default: 180)
my $VERSION = '$Revision: 1.11 $';
($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
-my %opts = Vars;
+my %opts;
my $clearadm;
-$opts{sortby} ||= 'age';
-$opts{region} ||= $Clearcase::CC->region;
+$opts{sortby} ||= 'age';
+$opts{ageThreshold} = 180; # Default number of days a view must be older than
my $subtitle = 'View Aging Report';
my $email;
. $port
. $scriptName;
-my (%total, $action);
-my $ageThreshold = 180; # Default number of days a view must be older than
+my %total;
my $nbrThreshold; # Number of views threshold - think top 10
sub GenerateRegion ($) {
my ($region) = @_;
- verbose "Processing $region";
+ verbose "Processing region $region";
$total{Regions}++;
my $views = Clearcase::Views->new ($region);
my $i = 0;
- foreach my $name (@Views) {
+ for my $name (@Views) {
$total{Views}++;
if (++$i % 100 == 0) {
my $ownerid = $view->owner;
- if ($ownerid) {
- $user = User->new ($ownerid);
+ if ($ownerid =~ /^\w+(\\|\/)(\w+)/) {
+ # TODO: Handle user identification better
+ #$user = User->new ($ownerid);
- $user->{name} ||= 'Unknown';
+ $ownerid = $2;
+ $user->{name} = $2;
+ $user->{email} = "$2\@gddsi.com";
} else {
$ownerid = 'Unknown';
$user->{name} = 'Unknown';
+ $user->{email} = 'unknown@gddsi.com';
} # if
my $age = 0;
# Compute age
$age = Age ($modified_date);
$ageSuffix = $age != 1 ? 'days' : 'day';
- } else {
- $modified_date = 'Unknown';
+ #} else {
+ # $modified_date = 'Unknown';
} # if
- my ($err, $msg) = $clearadm->AddView (
- system => $view->shost,
- region => $view->region,
- tag => $view->tag,
- owner => $ownerid,
- ownerName => $user->{name},
- email => $user->{email},
- type => $type,
- gpath => $gpath,
- modified_date => $modified_date,
- age => $age,
- ageSuffix => $ageSuffix,
+ my %oldView = $clearadm->GetView($view->tag, $view->region);
+
+ my ($err, $msg);
+
+ my %viewRec = (
+ system => $view->shost,
+ region => $view->region,
+ tag => $view->tag,
+ owner => $ownerid,
+ ownerName => $user->{name},
+ email => $user->{email},
+ type => $type,
+ gpath => $gpath,
+ age => $age,
+ ageSuffix => $ageSuffix,
);
- error "Unable to add view $name to Clearadm\n$msg", $err
- if $err;
- } # foreach
+ # Some views have not yet been modified
+ $viewRec{modified} = $modified_date if $modified_date;
+
+ if (%oldView) {
+ ($err, $msg) = $clearadm->UpdateView($view->tag, $view->region, %viewRec);
- verbose "\nProcessed $region";
+ error "Unable to update view $name in Clearadm\n$msg", $err if $err;
+ } else {
+ ($err, $msg) = $clearadm->AddView (%viewRec);
+
+ error "Unable to add view $name to Clearadm\n$msg", $err if $err;
+ } # if
+ } # for
+
+ verbose "\nProcessed region $region";
return;
} # GenerateRegion
my ($region) = @_;
if ($region =~ /all/i) {
- foreach ($Clearcase::CC->regions) {
- GenerateRegion $_;
- } # foreach
+ for ($Clearcase::CC->regions) {
+ GenerateRegion $_;
+ } # for
} else {
GenerateRegion $region;
} # if
my @sortedViews;
- if ($opts{sort} eq 'age') {
+ if ($opts{sortby} eq 'age') {
# Sort by age numerically decending
@sortedViews = sort { $$b{$opts{sortby}} <=> $$a{$opts{sortby}} } @views;
} else {
- @sortedViews = sort { $$a{$opts{sort}} cmp $$b{$opts{sort}} } @views;
+ @sortedViews = sort { $$a{$opts{sortby}} cmp $$b{$opts{sortby}} } @views;
} # if
$total{Reported} = 0;
- foreach (@sortedViews) {
+ for (@sortedViews) {
my %view = %{$_};
last
if ($nbrThreshold and $total{Reported} + 1 > $nbrThreshold) or
- ($view{age} < $ageThreshold);
+ ($view{age} < $opts{ageThreshold});
$total{Reported}++;
.
format STDOUT =
@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<< @<<<<<<<<<<<<<<< @>>>> @<<<<
-$view{tag},$view{owner},$view{type},$view{modified_date},$view{age},$view{ageSuffix}
+$view{tag},$view{owner},$view{type},$view{modified},$view{age},$view{ageSuffix}
.
write;
- } # foreach
+ } # for
return;
} # Report
width => '100%',
};
- my $registryHost = $Clearcase::CC->registry_host;
-
- $registryHost = font {class => 'unknown'}, 'Unknown'
- unless $registryHost;
-
$caption .= start_Tr;
$caption .= td {
-align => 'left',
-width => '30%',
}, font ({-class => 'label'}, 'Registry: '),
- $registryHost, '<br>',
+ setField($Clearcase::CC->registry_host), '<br>',
font ({-class => 'label'}, 'Views: '),
$nbrViews;
$caption .= td {
# Sort by age numerically decending
@views = $opts{reverse} == 1
? sort { $$a{$opts{sortby}} <=> $$b{$opts{sortby}} } @views
- : sort { $$b{$opts{sortby}} <=> $$a{$opts{sortby}} } @views
+ : sort { $$b{$opts{sortby}} <=> $$a{$opts{sortby}} } @views;
} else {
@views = $opts{reverse} == 1
? sort { $$b{$opts{sortby}} cmp $$a{$opts{sortby}} } @views
- : sort { $$a{$opts{sortby}} cmp $$b{$opts{sortby}} } @views
+ : sort { $$a{$opts{sortby}} cmp $$b{$opts{sortby}} } @views;
} # if
my $i;
- foreach (@views) {
+ for (@views) {
my %view = %{$_};
+ next if $view{region} ne $opts{region};
+
my $owner = $view{owner};
if ($view{owner} =~ /\S+(\\|\/)(\S+)/) {
$owner = $view{ownerName} ? $view{ownerName} : 'Unknown';
- my $rowClass= $view{age} > $ageThreshold ? 'oldview' : 'view';
+ next if $opts{user} and $owner ne $opts{user};
+
+ my $rowClass= $view{age} > $opts{ageThreshold} ? 'oldview' : 'view';
$table .= start_Tr {
class => $rowClass
class => $view{type}
}, $view{age}, ' ', $view{ageSuffix});
$table .= end_Tr;
- } # foreach
+ } # for
$table .= end_table;
<p>Won't you take a moment to review this message and clean up any views you no
longer need?</p>
-<p>The following views are owned by you and have not been modified in $ageThreshold
+<p>The following views are owned by you and have not been modified in $opts{ageThreshold}
days:</p>
END
my @userViews;
my $currUser = $views [0]->{ownerName};
- foreach (@views) {
+ for (@views) {
my %view = %{$_};
next
@userViews =();
} else {
- if ($view{age} > $ageThreshold) {
+ if ($view{age} > $opts{ageThreshold}) {
push @userViews, \%view
if !-f "$view{gpath}/ageless";
} # if
} # if
- } # foreach
+ } # for
display"Done";
'nbrThreshold=i',
) or Usage "Invalid parameter";
-local $| = 1;
+# Get options from CGI
+my %CGIOpts = Vars;
+
+$opts{$_} = $CGIOpts{$_} for keys %CGIOpts;
-$opts{region} ||= '';
+local $| = 1;
# Announce ourselves
verbose "$FindBin::Script v$VERSION";
$clearadm = Clearadm->new;
-if ($action and $action eq 'generate') {
+if ($opts{action} and $opts{action} eq 'generate') {
+ $opts{region} ||= 'all';
+
Generate $opts{region};
- Stats \%total;
+ Stats \%total if $opts{verbose};
} else {
if ($opts{region} and ($opts{region} eq 'Clearcase not installed')) {
heading;
exit 1;
} # if
+ $opts{region} ||= $Clearcase::CC->region;
+
my @views = $clearadm->FindView (
'all',
$opts{region},
$opts{user}
);
- if ($action and $action eq 'report') {
+ if ($opts{action} and $opts{action} eq 'report') {
Report @views;
Stats \%total;
} elsif ($email) {
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
sub DisplayTable ($) {
my ($view) = @_;
- # Data fields
- my $tag = setField $view->tag;
- my $server = setField $view->shost;
- my $region = setField $view->region;
- my $properties = setField $view->properties;
- my $text_mode = setField $view->text_mode;
my $permissions = setField $view->owner_mode
. setField $view->group_mode
. setField $view->other_mode;
- my $owner = setField $view->owner;
my $active = ($view->active) ? 'YES' : 'NO';
- my $created_by = setField $view->created_by;
- my $created_date = setField $view->created_date;
- my $cs_updated_by = setField $view->cs_updated_by;
- my $cs_updated_date = setField $view->cs_updated_date;
- my $gpath = setField $view->gpath;
- my $access_path = setField $view->access_path;
- my $uuid = setField $view->uuid;
+ my $gpath = $view->gpath;
$gpath = font {-class => 'unknown'}, '<no-gpath>'
if $gpath eq '<no-gpath>';
display start_Tr;
display th {class => 'label'}, 'Tag:';
- display td {class => 'data', colspan => 3}, $tag;
+ display td {class => 'data', colspan => 3}, setField $view->tag;
display th {class => 'label'}, 'Server:';
display td {class => 'data'}, a {
- href => "serverdetails.cgi?server=$server"
- }, $server;
+ href => 'systemdetails.cgi?system=' . $view->shost
+ }, $view->shost;
display th {class => 'label'}, 'Region:';
- display td {class => 'data'}, $region;
+ display td {class => 'data'}, $view->region;
display end_Tr;
display start_Tr;
display th {class => 'label'}, 'Properties:';
- display td {class => 'data', colspan => 3}, $properties;
+ display td {class => 'data', colspan => 3}, $view->properties;
display th {class => 'label'}, 'Text Mode:';
- display td {class => 'data'}, $text_mode;
+ display td {class => 'data'}, $view->text_mode;
display th {class => 'label'}, 'Permission:';
display td {class => 'data'}, $permissions;
display end_Tr;
display start_Tr;
display th {class => 'label'}, 'Owner:';
- display td {class => 'data', colspan => 3}, $owner;
+ display td {class => 'data', colspan => 3}, $view->owner;
display th {class => 'label'}, 'Active:';
display td {class => 'data', colspan => 3}, $active;
display end_Tr;
display start_Tr;
display th {class => 'label'}, 'Created by:';
- display td {class => 'data', colspan => 3}, $created_by;
+ display td {class => 'data', colspan => 3}, $view->created_by;
display th {class => 'label'}, 'on:';
- display td {class => 'data', colspan => 3}, $created_date;
+ display td {class => 'data', colspan => 3}, $view->created_date;
display end_Tr;
display start_Tr;
display th {class => 'label'}, 'CS Updated by:';
- display td {class => 'data', colspan => 3}, $cs_updated_by;
+ display td {class => 'data', colspan => 3}, $view->cs_updated_by;
display th {class => 'label'}, 'on:';
- display td {class => 'data', colspan => 3}, $cs_updated_date;
+ display td {class => 'data', colspan => 3}, $view->cs_updated_date;
display end_Tr;
display start_Tr;
display start_Tr;
display th {class => 'label'}, 'Access Path:';
- display td {class => 'data', colspan => 7}, $access_path;
+ display td {class => 'data', colspan => 7}, $view->access_path;
display end_Tr;
display start_Tr;
display th {class => 'label'}, 'UUID:';
- display td {class => 'data', colspan => 7}, $uuid;
+ display td {class => 'data', colspan => 7}, $view->uuid;
+ display end_Tr;
+
+ display start_Tr;
+ display th {class => 'labelCentered', colspan => 10}, 'View Storage Pools';
+ display end_Tr;
+
+ 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
+ }, img {
+ src => "plotstorage.cgi?type=view&storage=private&tiny=1&tag=" . $view->tag,
+ border => 0,
+ };
+ display th {class => 'label'}, 'Private:';
+ display td {class => 'data', colspan => 5, align => 'center'}, a {href =>
+ "plot.cgi?type=view&storage=db&tag=" . $view->tag
+ }, img {
+ src => "plotstorage.cgi?type=view&storage=db&tiny=1&tag=" . $view->tag,
+ border => 0,
+ };
+ display end_Tr;
+
+ 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
+ }, img {
+ src => "plotstorage.cgi?type=view&storage=admin&tiny=1&tag=" . $view->tag,
+ border => 0,
+ };
+ 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
+ }, img {
+ src => "plotstorage.cgi?type=view&storage=total&tiny=1&tag=" . $view->tag,
+ border => 0,
+ };
display end_Tr;
display end_table;
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
--- /dev/null
+#!/usr/local/bin/perl
+
+=pod
+
+=head1 NAME $RCSfile: vobdetails.cgi,v $
+
+View Details
+
+=head1 VERSION
+
+=over
+
+=item Author
+
+Andrew DeFaria <Andrew@ClearSCM.com>
+
+=item Revision
+
+$Revision: 1.11 $
+
+=item Created:
+
+Mon Oct 25 11:10:47 PDT 2008
+
+=item Modified:
+
+$Date: 2011/01/14 16:51:58 $
+
+=back
+
+=head1 SYNOPSIS
+
+ Usage vobdetails.cgi: [-u|sage] [-r|egion <region>] -vo|b <vobtag>
+ [-ve|rbose] [-d|ebug]
+
+ Where:
+ -u|sage: Displays usage
+ -r|egion <region>: Region to use when looking for the vob
+ -vo|b <vobtag>: Tag of vob to display details for
+
+ -ve|rbose: Be verbose
+ -d|ebug: Output debug messages
+
+=head2 DESCRIPTION
+
+This script display the details for the given vob
+
+=cut
+
+use strict;
+use warnings;
+
+use FindBin;
+use Getopt::Long;
+use CGI qw (:standard :cgi-lib *table start_Tr end_Tr);
+use CGI::Carp 'fatalsToBrowser';
+
+use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib";
+
+use ClearadmWeb;
+use Clearcase;
+use Clearcase::Vob;
+use Clearcase::Vobs;
+use Display;
+use Utils;
+
+my %opts = Vars;
+
+my $subtitle = 'VOB Details';
+
+if ($Clearcase::CC->region) {
+ $opts{region} ||= $Clearcase::CC->region;
+} else {
+ $opts{region} ||= 'Clearcase not installed';
+} # if
+
+my $VERSION = '$Revision: 1.11 $';
+ ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
+
+sub DisplayTable ($) {
+ my ($vob) = @_;
+
+ my $active = ($vob->active) ? 'YES' : 'NO';
+ my $gpath = $vob->gpath;
+
+ $gpath = font {-class => 'unknown'}, '<no-gpath>'
+ if $gpath eq '<no-gpath>';
+
+ display start_table {
+ -cellspacing => 1,
+ -class => 'main',
+ };
+
+ display start_Tr;
+ display th {class => 'label'}, 'Tag:';
+ display td {class => 'data', colspan => 3}, setField $vob->tag;
+ display th {class => 'label'}, 'Server:';
+ display td {class => 'data'}, a {
+ href => 'systemdetails.cgi?system=' . $vob->shost
+ }, $vob->shost;
+ display th {class => 'label'}, 'Region:';
+ display td {class => 'data', colspan => 3}, $vob->region;
+ display end_Tr;
+
+ display start_Tr;
+ display th {class => 'label'}, 'Type:';
+ display td {class => 'data', colspan => 3}, $vob->access;
+ display th {class => 'label'}, 'Attributes:';
+ display td {class => 'data'}, $vob->vob_registry_attributes;
+ display th {class => 'label'}, 'Mount Opts:';
+ display td {class => 'data', colspan => 3}, $vob->mopts;
+ display end_Tr;
+
+ display start_Tr;
+ display th {class => 'label'}, 'Owner:';
+ display td {class => 'data', colspan => 3}, $vob->owner;
+ display th {class => 'label'}, 'Active:';
+ display td {class => 'data'}, $active;
+ display th {class => 'label'}, 'ACLs Enabled:';
+ display td {class => 'data', colspan => 3}, $vob->aclsEnabled;
+ display end_Tr;
+
+ display start_Tr;
+ display th {class => 'label'}, 'Created by:';
+ display td {class => 'data', colspan => 3}, $vob->ownername;
+ display th {class => 'label'}, 'on:';
+ display td {class => 'data'}, $vob->created;
+ display th {class => 'label'}, 'Atomic Checkin:';
+ display td {class => 'data', colspan => 3}, $vob->atomicCheckin;
+ display end_Tr;
+
+ display start_Tr;
+ display th {class => 'label'}, 'Comment:';
+ display td {class => 'data', colspan => 5}, $vob->comment;
+ display th {class => 'label'}, 'Schema Version:';
+ display td {class => 'data', colspan => 3}, $vob->schemaVersion;
+ display end_Tr;
+
+ display start_Tr;
+ display th {class => 'label'}, 'Global Path:';
+ display td {class => 'data', colspan => 5}, $gpath;
+ display th {class => 'label'}, 'Registry Attributes:';
+ display td {class => 'data', colspan => 3}, $vob->vob_registry_attributes;
+ display end_Tr;
+
+ display start_Tr;
+ display th {class => 'label'}, 'Access Path:';
+ display td {class => 'data', colspan => 5}, $vob->access_path;
+ display th {class => 'label'}, 'Group:';
+ display td {class => 'data', colspan => 3}, $vob->group;
+ display end_Tr;
+
+ display start_Tr;
+ display th {class => 'label'}, 'Family UUID:';
+ display td {class => 'data', colspan => 5}, $vob->family_uuid;
+ display th {class => 'label'}, 'Remote Privilage:';
+ display td {class => 'data', colspan => 3}, $vob->remotePrivilege;
+ display end_Tr;
+
+ display start_Tr;
+ display th {class => 'label'}, 'Replica UUID:';
+ display td {class => 'data', colspan => 5}, $vob->replica_uuid;
+ display th {class => 'label'}, 'Master Replica:';
+ display td {class => 'data', colspan => 3}, $vob->masterReplica;
+ display end_Tr;
+
+ my $groups = join "<br>", $vob->groups;
+
+ display start_Tr;
+ display th {class => 'label'}, 'Groups:';
+ display td {class => 'data', colspan => 10}, $groups;
+ display end_Tr;
+
+ my %attributes = $vob->attributes;
+ my $attributes = '';
+
+ for (keys %attributes) {
+ $attributes .= "$_ = $attributes{$_}<br>";
+ } # for
+
+ display start_Tr;
+ display th {class => 'label'}, 'Attributes:';
+ display td {class => 'data', colspan => 10}, $attributes;
+ display end_Tr;
+
+ my %hyperlinks = $vob->hyperlinks;
+ my $hyperlinks = '';
+
+ for (keys %hyperlinks) {
+ $hyperlinks .= "$_ = $hyperlinks{$_}<br>";
+ } # for
+
+ display start_Tr;
+ display th {class => 'label'}, 'Hyperlinks:';
+ display td {class => 'data', colspan => 10}, $hyperlinks;
+ display end_Tr;
+
+ display start_Tr;
+ display th {class => 'labelCentered', colspan => 10}, 'VOB Storage Pools';
+ display end_Tr;
+
+ 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
+ }, img {
+ src => "plotstorage.cgi?type=vob&storage=admin&tiny=1&tag=" . $vob->tag,
+ border => 0,
+ };
+ 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
+ }, img {
+ src => "plotstorage.cgi?type=vob&storage=source&tiny=1&tag=" . $vob->tag,
+ border => 0,
+ };
+ display end_Tr;
+
+ display start_Tr;
+ 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
+ }, img {
+ src => "plotstorage.cgi?type=vob&storage=db&tiny=1&tag=" . $vob->tag,
+ border => 0,
+ };
+ 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
+ }, img {
+ src => "plotstorage.cgi?type=vob&storage=derivedobj&tiny=1&tag=" . $vob->tag,
+ border => 0,
+ };
+ display end_Tr;
+
+ display start_Tr;
+ 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
+ }, img {
+ src => "plotstorage.cgi?type=vob&storage=cleartext&tiny=1&tag=" . $vob->tag,
+ border => 0,
+ };
+ 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
+ }, img {
+ src => "plotstorage.cgi?type=vob&storage=total&tiny=1&tag=" . $vob->tag,
+ border => 0,
+ };
+ display end_Tr;
+
+ display end_table;
+
+ return;
+} # DisplayTable
+
+sub DisplayRegion {
+ display start_form (action => 'vobdetails.cgi');
+
+ display 'Region ';
+
+ my ($defaultRegion, @regions) = ('', ('Clearcase not installed'));
+
+ display popup_menu (
+ -name => 'region',
+ -values => [@regions],
+ -default => $defaultRegion,
+ -onchange => 'submit();',
+ );
+
+ display submit (
+ -value => 'Go',
+ );
+
+ display end_form;
+
+ return
+} # DisplayRegion
+
+sub DisplayVobs($) {
+ my ($region) = @_;
+
+ my @vobs = Clearcase::Vobs->new ($region);
+
+ unless (@vobs) {
+ push @vobs, 'No VOBs';
+ } # unless
+
+ display start_form (action => 'vobdetails.cgi');
+
+ display 'Region ';
+
+ display popup_menu (
+ -name => 'region',
+ -values => [$Clearcase::CC->regions],
+ -default => $region,
+ -onchange => 'submit();',
+ );
+
+ display b ' VOB: ';
+
+ display popup_menu (
+ -name => 'vob',
+ -values => \@vobs,
+ -onchange => 'submit();',
+ );
+
+ display submit (
+ -value => 'Go',
+ );
+
+ display end_form;
+
+ return;
+} # DisplayVobs
+
+# Main
+GetOptions (
+ \%opts,
+ 'usage' => sub { Usage },
+ 'verbose' => sub { set_verbose },
+ 'debug' => sub { set_debug },
+ 'vob=s',
+ 'region=s',
+) or Usage "Invalid parameter";
+
+# Announce ourselves
+verbose "$FindBin::Script v$VERSION";
+
+heading $subtitle;
+
+display h1 {
+ -class => 'center',
+}, $subtitle;
+
+unless ($opts{tag}) {
+ unless ($opts{region}) {
+ DisplayRegion;
+ } else {
+ DisplayVobs $opts{region};
+ } # unless
+
+ exit;
+} # unless
+
+my $vob = Clearcase::Vob->new ($opts{tag}, $opts{region});
+
+DisplayTable $vob;
+
+footing;
+
+=pod
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+DEBUG: If set then $debug is set to this level.
+
+VERBOSE: If set then $verbose is set to this level.
+
+TRACE: If set then $trace is set to this level.
+
+=head1 DEPENDENCIES
+
+=head2 Perl Modules
+
+L<CGI>
+
+L<CGI::Carp|CGI::Carp>
+
+L<FindBin>
+
+L<Getopt::Long|Getopt::Long>
+
+=head2 ClearSCM Perl Modules
+
+=begin man
+
+ ClearadmWeb
+ Clearcase
+ Clearcase::View
+ Clearcase::Views
+ Display
+ Utils
+
+=end man
+
+=begin html
+
+<blockquote>
+<a href="http://clearscm.com/php/scm_man.php?file=clearadm/lib/ClearadmWeb.pm">ClearadmWeb</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase.pm">Clearcase</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/View.pm">Clearcase::View</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/Views.pm">Clearcase::Views</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Display.pm">Display</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Utils.pm">Utils</a><br>
+</blockquote>
+
+=end html
+
+=head1 BUGS AND LIMITATIONS
+
+There are no known bugs in this script
+
+Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
+
+=cut
-#!/usr/bin/perl
+#!/usr/local/bin/perl
=pod
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 start_ol end_ol);
use CGI::Carp 'fatalsToBrowser';
use lib "$FindBin::Bin/lib", "$FindBin::Bin/../lib";
use ClearadmWeb;
use Clearcase;
use Clearcase::Server;
+use Clearcase::Vobs;
+use Clearcase::Vob;
use Display;
use Utils;
my $VERSION = '$Revision: 1.9 $';
($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
+sub DisplayVobs($) {
+ my ($server) = @_;
+
+ display h3 {
+ -class => 'center',
+ }, "Vobs on " . $server->name;
+
+ display start_table;
+
+ display start_Tr;
+ display th {
+ -class => 'labelCentered',
+ }, '#';
+ display th {
+ -class => 'labelCentered',
+ }, 'Tag';
+ display th {
+ -class => 'labelCentered',
+ }, 'Type';
+ display th {
+ -class => 'labelCentered',
+ }, 'Active';
+ display th {
+ -class => 'labelCentered',
+ }, 'Access Path';
+ display th {
+ -class => 'labelCentered',
+ }, 'Attributes';
+ display end_Tr;
+
+ my $i = 0;
+
+ my $vobs = Clearcase::Vobs->new($server->name);
+
+ for (sort $vobs->vobs) {
+ my $vob = Clearcase::Vob->new($_);
+
+ display start_Tr;
+ display td {
+ -class => 'dataCentered',
+ }, ++$i;
+ display td {
+ -class => 'data',
+ }, a {-href => "vobdetails.cgi?tag=" . $vob->tag}, $vob->tag;
+ display td {
+ -class => 'dataCentered',
+ }, $vob->access;
+ display td {
+ -class => 'dataCentered',
+ }, $vob->active;
+ display td {
+ -class => 'data',
+ }, $vob->access_path;
+ display td {
+ -class => 'data',
+ }, $vob->vob_registry_attributes;
+ display end_Tr;
+ } # for
+
+ display end_table;
+} # DisplayVob
+
sub DisplayTable (@) {
my (@vobServers) = @_;
display th {
-class => 'labelCentered',
}, 'OS Version';
+ display th {
+ -class => 'labelCentered',
+ }, 'Hardware';
+ display th {
+ -class => 'labelCentered',
+ }, 'Registry Host';
+ display th {
+ -class => 'labelCentered',
+ }, 'Region';
+ display th {
+ -class => 'labelCentered',
+ }, 'License Host';
display end_Tr;
my $i = 0;
- foreach (@vobServers) {
- my $server = Clearcase::Server->new ($_, $opts{region});
-
- # Data fields
- my $name = $server->name;
- my $ccVer = $server->ccVer;
- my $osVer = $server->osVer;
+ my $server;
- $ccVer ||= $unknown;
- $osVer ||= $unknown;
+ for (@vobServers) {
+ $server = Clearcase::Server->new ($_, $opts{region});
display start_Tr;
display td {
-class => 'dataCentered',
}, ++$i;
display td {
- -class => 'data',
- }, a {-href => "serverdetails.cgi?server=$name"}, $name;
+ -class => 'dataCentered',
+ }, a {-href => "systemdetails.cgi?system=" . $server->name}, $server->name;
display td {
- -class => 'data',
- }, $ccVer;
+ -class => 'dataCentered',
+ }, $server->ccVer;
display td {
- -class => 'data',
- }, $osVer;
+ -class => 'dataCentered',
+ }, $server->osVer;
+ display td {
+ -class => 'dataCentered',
+ }, $server->hardware;
+ display td {
+ -class => 'dataCentered',
+ }, a {-href => "systemdetails.cgi?system=" . $server->registryHost}, $server->registryHost;
+ display td {
+ -class => 'dataCentered',
+ }, $server->registryRegion;
+ display td {
+ -class => 'dataCentered',
+ }, $server->licenseHost;
display end_Tr;
- } # foreach
- display end_table;
+ display start_Tr;
+ display th {
+ -class => 'labelCentered',
+ }, 'MVFS';
+ display th {
+ -class => 'labelCentered',
+ }, 'Scaling';
+ display th {
+ -class => 'labelCentered',
+ }, 'Free Mnodes';
+ display th {
+ -class => 'labelCentered',
+ }, 'Free Mnodes Cleartext';
+ display th {
+ -class => 'labelCentered',
+ }, 'File names';
+ display th {
+ -class => 'labelCentered',
+ }, 'Directory names';
+ display th {
+ -class => 'labelCentered',
+ }, 'Blocks Per Directory';
+ display th {
+ -class => 'labelCentered',
+ }, 'Names not found';
+ display end_Tr;
+
+ display start_Tr;
+ display td {
+ -class => 'dataCentered',
+ }, ' ';
+ display td {
+ -class => 'dataCentered',
+ }, $server->scalingFactor;
+ display td {
+ -class => 'dataRight',
+ }, $server->mvfsFreeMnodes;
+ display td {
+ -class => 'dataRight',
+ }, $server->mvfsFreeMnodesCleartext;
+ display td {
+ -class => 'dataRight',
+ }, $server->mvfsFileNames;
+ display td {
+ -class => 'dataRight',
+ }, $server->mvfsDirectoryNames;
+ display td {
+ -class => 'dataRight',
+ }, $server->mvfsBlocksPerDirectory;
+ display td {
+ -class => 'dataRight',
+ }, $server->mvfsNamesNotFound;
+ display end_Tr;
+
+ display start_Tr;
+ display th {
+ -class => 'labelCentered',
+ }, 'RPC Handles';
+ display th {
+ -class => 'labelCentered',
+ }, 'Cleartext Idle Lifetime';
+ display th {
+ -class => 'labelCentered',
+ }, 'VOB HTS';
+ display th {
+ -class => 'labelCentered',
+ }, 'Cleartext HTS';
+ display th {
+ -class => 'labelCentered',
+ }, 'Thread HTS';
+ display th {
+ -class => 'labelCentered',
+ }, 'DNC HTS';
+ display th {
+ -class => 'labelCentered',
+ }, 'Process HTS';
+ display th {
+ -class => 'labelCentered',
+ }, 'Initial Mnode Table Size';
+ display end_Tr;
+
+ display start_Tr;
+ display td {
+ -class => 'dataRight',
+ }, $server->mvfsRPCHandles;
+ display td {
+ -class => 'dataRight',
+ }, $server->cleartextIdleLifetime;
+ display td {
+ -class => 'dataRight',
+ }, $server->vobHashTableSize;
+ display td {
+ -class => 'dataRight',
+ }, $server->cleartextHashTableSize;
+ display td {
+ -class => 'dataRight',
+ }, $server->threadHashTableSize;
+ display td {
+ -class => 'dataRight',
+ }, $server->dncHashTableSize;
+ display td {
+ -class => 'dataRight',
+ }, $server->processHashTableSize;
+ display td {
+ -class => 'dataRight',
+ }, $server->mvfsInitialMnodeTableSize;
+ display end_Tr;
+ display end_table;
+ } # for
+ display p;
+ DisplayVobs $server;
+
return;
} # DisplayTable
my %vobServers;
-foreach (@output) {
+for (@output) {
if (/Server host: (.*)/) {
$vobServers{$1} = undef;
} # if
-} # foreach
+} # for
DisplayTable sort (keys (%vobServers));
Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-=cut
\ No newline at end of file
+=cut
if (!$clearpid) {
# Simple check to see if we can execute cleartool
@output = `$cleartool -ver 2>&1`;
+ @output = ();
return (-1, 'Clearcase not installed')
unless $? == 0;
=head2 SYNOPSIS
Provides access to information about a Clearcase Server.
+
=head2 DESCRIPTION
This module implements an object oriented interface to a Clearcase
my $self = bless { name => $name }, $class;
+ $self->updateServerInfo($name);
+
return $self;
} # new
return $self->{mvfsBlocksPerDirectory};
} # mvfsBlocksPerDirectory
-sub mvfsCleartextMnodes () {
+sub mvfsFreeMnodesCleartext() {
my ($self) = @_;
- return $self->{mvfsCleartextMnodes};
-} # mvfsCleartextMnodes
+ return $self->{mvfsFreeMnodesCleartext};
+} # mvfsFreeMnodesCleartext
sub mvfsDirectoryNames () {
my ($self) = @_;
return $self->{processHashTableSize};
} # processHashTableSize
+sub updateServerInfo($) {
+ my ($self, $host) = @_;
+
+ my ($status, @output) = $Clearcase::CC->execute(
+ "hostinfo -long -properties -full $host"
+ );
+
+ for (@output) {
+ if (/Product: ClearCase (.*)/) {
+ $self->{ccVer} = $1;
+ } elsif (/Operating system: (.*)/) {
+ $self->{osVer} = $1;
+ } elsif (/Hardware type: (.*)/) {
+ $self->{hardware} = $1;
+ } elsif (/License host: (.*)/) {
+ $self->{licenseHost} = $1;
+ } elsif (/Registry host: (.*)/) {
+ $self->{registryHost} = $1;
+ } elsif (/Registry region: (.*)/) {
+ $self->{registryRegion} = $1;
+ } elsif (/Blocks per directory: (.*)/) {
+ $self->{mvfsBlocksPerDirectory} = $1;
+ } elsif (/Free mnodes for cleartext: (.*)/) {
+ $self->{mvfsFreeMnodesCleartext} = $1;
+ } elsif (/Directory names: (.*)/) {
+ $self->{mvfsDirectoryNames} = $1;
+ } elsif (/File names: (.*)/) {
+ $self->{mvfsFileNames} = $1;
+ } elsif (/Free mnodes: (.*)/) {
+ $self->{mvfsFreeMnodes} = $1;
+ } elsif (/Initial mnode table size: (.*)/) {
+ $self->{mvfsInitialMnodeTableSize} = $1;
+ } elsif (/Minimum free mnodes for cleartext: (.*)/) {
+ $self->{mvfsMinCleartextMnodes} = $1;
+ } elsif (/Mimimum free mnodes: (.*)/) {
+ $self->{mvfsMinFreeMnodes} = $1;
+ } elsif (/Names not found: (.*)/) {
+ $self->{mvfsNamesNotFound} = $1;
+ } elsif (/RPC handles: (.*)/) {
+ $self->{mvfsRPCHandles} = $1;
+ } elsif (/Scaling factor to initialize MVFS cache sizes: (.*)/) {
+ $self->{scalingFactor} = $1;
+ } elsif (/Cleartext idle lifetime: (.*)/) {
+ $self->{cleartextIdleLifetime} = $1;
+ } elsif (/VOB hash table size: (.*)/) {
+ $self->{vobHashTableSize} = $1;
+ } elsif (/Cleartext hash table size: (.*)/) {
+ $self->{cleartextHashTableSize} = $1;
+ } elsif (/Thread hash table size: (.*)/) {
+ $self->{threadHashTableSize} = $1;
+ } elsif (/DNC hash table size: (.*)/) {
+ $self->{dncHashTableSize} = $1;
+ } elsif (/Process hash table size: (.*)/) {
+ $self->{processHashTableSize} = $1;
+ } # if
+ } # for
+
+ return;
+} # updateServerInfo
+
1;
=pod
display_nolf MAGENTA . "Additional groups:\t";
- foreach ($view->additional_groups) {
+ for ($view->additional_groups) {
display_nolf "$_ ";
- } # foreach
+ } # for
display '';
=cut
return $self->{tag};
- } # tag
+} # tag
sub text_mode () {
my ($self) = @_;
$self->{ucm} = 0;
$self->{additional_groups} = '';
- foreach (@output) {
+ for (@output) {
if (/Global path: (.*)/) {
$self->{gpath} = $1;
} elsif (/Server host: (.*)/) {
$self->{text_mode} = $1;
} elsif (/Properties: (.*)/) {
$self->{properties} = $1;
- } elsif (/Owner: (\S+)\s+: (\S+) /) {
+ } elsif (/View owner: (\S+)$/) {
+ # It is possible that there may be problems enumerating
+ # -properties and -full when listing views due to servers
+ # no longer being available. Still the "View owner" line
+ # denotes the view's owner.
+ $self->{owner} = $1;
+ $self->{owner_mode} = '';
+ } elsif (/Owner: (\S+)\s+: (\S+)/) {
$self->{owner} = $1;
$self->{owner_mode} = $2;
} elsif (/Group: (.+)\s+:\s+(\S+)\s+/) {
$self->{group} = $1;
- $self->{group_mode} = $2;
- } elsif (/Other:\s+: (\S+) /) {
+ $self->{group_mode} = $2;
+ } elsif (/Other:\s+: (\S+)/) {
$self->{other_mode} = $1;
} elsif (/Additional groups: (.*)/) {
my @additional_groups = split /\s+/, $1;
$self->{additional_groups} = \@additional_groups;
} # if
- } # foreach
+ } # for
# Change modes to numeric
$self->{mode} = 0;
return;
} # updateViewInfo
+sub viewPrivateStorage() {
+ my ($self) = @_;
+
+=pod
+
+=head1 viewPrivateStorage
+
+Returns the view private storage size for this view.
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item view private storage
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ $self->updateViewSpace unless ($self->{viewPrivateStorage});
+
+ return $self->{viewPrivateStorage};
+} # viewPrivateStorage
+
+sub viewPrivateStoragePct() {
+ my ($self) = @_;
+
+=pod
+
+=head1 viewPrivateStoragePct
+
+Returns the view private storage percent for this view.
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item view private storage
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ $self->updateViewSpace unless ($self->{viewPrivateStoragePct});
+
+ return $self->{viewPrivateStoragePct};
+} # viewPrivateStoragePct
+
+sub viewDatabase() {
+ my ($self) = @_;
+
+=pod
+
+=head1 viewDatabase
+
+Returns the view database size for this view.
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item view database size
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ $self->updateViewSpace unless ($self->{viewDatabase});
+
+ return $self->{viewDatabase};
+} # viewDatabase
+
+sub viewDatabasePct() {
+ my ($self) = @_;
+
+=pod
+
+=head1 viewDatabasePct
+
+Returns the view database percent for this view.
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item view database percent
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ $self->updateViewSpace unless ($self->{viewDatabasePct});
+
+ return $self->{viewDatabasePct};
+} # viewDatabasePct
+
+sub viewAdmin() {
+ my ($self) = @_;
+
+=pod
+
+=head1 viewAdmin
+
+Returns the view admin size for this view.
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item view admin size
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ $self->updateViewSpace unless ($self->{viewAdmin});
+
+ return $self->{viewAdmin};
+} # viewAdmin
+
+sub viewAdminPct() {
+ my ($self) = @_;
+
+=pod
+
+=head1 viewAdminPct
+
+Returns the view admin percent for this view.
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item view admin percent
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ $self->updateViewSpace unless ($self->{viewAdminPct});
+
+ return $self->{viewAdminPct};
+} # viewAdminPct
+
+sub viewSpace() {
+ my ($self) = @_;
+
+=pod
+
+=head1 viewSpace
+
+Returns the view total size for this view.
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item view space
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ $self->updateViewSpace unless ($self->{viewSpace});
+
+ return $self->{viewSpace};
+} # viewSpace
+
+sub viewSpacePct() {
+ my ($self) = @_;
+
+=pod
+
+=head1 viewSpacePct
+
+Returns the view database percent for this view.
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item view space percent
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ $self->updateViewSpace unless ($self->{viewSpacePct});
+
+ return $self->{viewSpacePct};
+} # viewSpacePct
+
+sub updateViewSpace() {
+ my ($self) = @_;
+
+ my ($status, @output) = $Clearcase::CC->execute (
+ "space -region $self->{region} -view $self->{tag}"
+ );
+
+ $self->{viewPrivateStorage} = 0.0;
+ $self->{viewPrivateStoragePct} = '0%';
+ $self->{viewAdmin} = 0.0;
+ $self->{viewAdminPct} = '0%';
+ $self->{viewDatabase} = 0.0;
+ $self->{viewDatabasePct} = '0%';
+ $self->{viewSpace} = 0.0;
+ $self->{viewSpacePct} = '0%';
+
+ for (@output) {
+ if (/\s*(\S+)\s*(\S+)\s*View private storage/) {
+ $self->{viewPrivateStorage} = $1;
+ $self->{viewPrivateStoragePct} = $2;
+ } elsif (/\s*(\S+)\s*(\S+)\s*View database/) {
+ $self->{viewDatabase} = $1;
+ $self->{viewDatabasePct} = $2;
+ } elsif (/\s*(\S+)\s*(\S+)\s*View administration/) {
+ $self->{viewAdmin} = $1;
+ $self->{viewAdminPct} = $2;
+ } elsif (/\s*(\S+)\s*(\S+)\s*Subtotal/) {
+ $self->{viewSpace} = $1;
+ $self->{viewSpacePct} = $2;
+ } # if
+ } # for
+
+ return;
+} # updateViewSpace
+
1;
=pod
display "DB Size:\t" . $vob->dbsize;
display "Adm Size:\t" . $vob->admsize;
display "CT Size:\t" . $vob->ctsize;
- display "DO Size:\t" . $vob->dbsize;
+ display "DO Size:\t" . $vob->dosize;
display "Src Size:\t" . $vob->srcsize;
display "Size:\t\t" . $vob->size;
=head2 tag
-Returns the VOB's tag
+Returns the VOB tag
Parameters:
=head2 gpath
-Returns the VOB's global path
+Returns the VOB global path
Parameters:
=head2 shost
-Returns the VOB's server host
+Returns the VOB server host
Parameters:
=head2 replica_uuid
-Returns the VOBS replica_uuid
+Returns the VOB replica_uuid
Parameters:
=head2 host
-Returns the VOB's host
+Returns the VOB host
Parameters:
=head2 access_path
-Returns the VOB's access path
+Returns the VOB access path
Parameters:
$self->{srcsize} = 0;
$self->{size} = 0;
- foreach (@output) {
+ for (@output) {
if (/(\d*\.\d).*VOB database(.*)/) {
$self->{dbsize} = $1;
} elsif (/(\d*\.\d).*administration data(.*)/) {
} elsif (/(\d*\.\d).*Subtotal(.*)/) {
$self->{size} = $1;
} # if
- } # foreach
+ } # for
+
+ return;
+} # expand_space
+
+sub expand_description () {
+ my ($self) = @_;
+
+ 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+)\)/) {
+ $self->{created} = $1;
+ $self->{ownername} = $2;
+ $self->{owner} = $3;
+ } elsif ($output[$i] =~ /^\s+\"(.+)\"/) {
+ $self->{comment} = $1;
+ } elsif ($output[$i] =~ /master replica: (.+)/) {
+ $self->{masterReplica} = $1;
+ } elsif ($output[$i] =~ /replica name: (.+)/) {
+ $self->{replicaName} = $1;
+ } elsif ($output[$i] =~ /VOB family featch level: (\d+)/) {
+ $self->{featureLevel} = $1;
+ } elsif ($output[$i] =~ /database schema version: (\d+)/) {
+ $self->{schemaVersion} = $1;
+ } elsif ($output[$i] =~ /modification by remote privileged user: (.+)/) {
+ $self->{remotePrivilege} = $1;
+ } elsif ($output[$i] =~ /atomic checkin: (.+)/) {
+ $self->{atomicCheckin} = $1;
+ } elsif ($output[$i] =~ /VOB ownership:/) {
+ while ($output[$i] !~ /Additional groups:/) {
+ $i++;
+
+ if ($output[$i++] =~ /owner (.+)/) {
+ $self->{owner} = $1;
+ } # if
+
+ if ($output[$i++] =~ /group (.+)/) {
+ $self->{group} = $1;
+ } # if
+ } # while
+
+ my @groups;
+
+ while ($output[$i] !~ /ACLs enabled/) {
+ if ($output[$i++] =~ /group (.+)/) {
+ push @groups, $1;
+ } # if
+ } # while
+
+ $self->{groups} = \@groups;
+
+ if ($output[$i++] =~ /ACLs enabled: (.+)/) {
+ $self->{aclsEnabled} = $1;
+ } # if
+
+ my %attributes;
+
+ while ($i < @output and $output[$i] !~ /Hyperlinks:/) {
+ if ($output[$i] !~ /Attributes:/) {
+ my ($key, $value) = split / = /, $output[$i];
+
+ # Trim leading spaces
+ $key =~ s/^\s*(\S+)/$1/;
+
+ # Remove unnecessary '"'s
+ $value =~ s/\"(.*)\"/$1/;
+
+ $attributes{$key} = $value;
+ } # if
+
+ $i++;
+ } # while
+
+ $self->{attributes} = \%attributes;
+
+ $i++;
+
+ my %hyperlinks;
+
+ while ($i < @output and $output[$i]) {
+ my ($key, $value) = split " -> ", $output[$i++];
+
+ # Trim leading spaces
+ $key =~ s/^\s*(\S+)/$1/;
+
+ $hyperlinks{$key} = $value;
+ } # while
+
+ $self->{hyperlinks} = \%hyperlinks;
+ } # if
+ } # for
return;
} # expand_space
+sub masterReplica() {
+
+=pod
+
+=head2 masterReplica
+
+Returns the VOB master replica
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB master replica
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ my ($self) = @_;
+
+ $self->expand_description unless $self->{masterReplica};
+
+ return $self->{masterReplica}
+} # masterReplica
+
+sub created() {
+
+=pod
+
+=head2 created
+
+Returns the date the VOB was created
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item Date the VOB was created
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ my ($self) = @_;
+
+ $self->expand_description unless $self->{created};
+
+ return $self->{created}
+} # created
+
+sub ownername() {
+
+=pod
+
+=head2 ownername
+
+Returns the VOB ownername
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB Owner Name
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ my ($self) = @_;
+
+ $self->expand_description unless $self->{ownername};
+
+ return $self->{ownername}
+} # ownername
+
+sub owner() {
+
+=pod
+
+=head2 owner
+
+Returns the VOB owner
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB master replica
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ my ($self) = @_;
+
+ $self->expand_description unless $self->{owner};
+
+ return $self->{owner}
+} # owner
+
+sub comment() {
+
+=pod
+
+=head2 comment
+
+Returns the VOB comment
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB comment
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ my ($self) = @_;
+
+ $self->expand_description unless $self->{comment};
+
+ return $self->{comment}
+} # comment
+
+sub replicaName() {
+
+=pod
+
+=head2 replicaName
+
+Returns the VOB replicaName
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB replica name
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ my ($self) = @_;
+
+ $self->expand_description unless $self->{replicaName};
+
+ return $self->{replicaName}
+} # replicaName
+
+sub featureLevel() {
+
+=pod
+
+=head2 featureLevel
+
+Returns the VOB featureLevel
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB feature level
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ my ($self) = @_;
+
+ $self->expand_description unless $self->{featureLevel};
+
+ return $self->{featureLevel}
+} # featureLevel
+
+sub schemaVersion() {
+
+=pod
+
+=head2 schemaVersion
+
+Returns the VOB schemaVersion
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB schema version
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ my ($self) = @_;
+
+ $self->expand_description unless $self->{schemaVersion};
+
+ return $self->{schemaVersion}
+} # schemaVersion
+
+sub remotePrivilege() {
+
+=pod
+
+=head2 remotePrivilege
+
+Returns the VOB remotePrivilege
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item Remote Privilege capability
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ my ($self) = @_;
+
+ $self->expand_description unless $self->{remotePrivilege};
+
+ return $self->{remotePrivilege}
+} # remotePrivilege
+
+sub atomicCheckin() {
+
+=pod
+
+=head2 atomicCheckin
+
+Returns the VOB atomicCheckin
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item Whether atomic check in enabled
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ my ($self) = @_;
+
+ $self->expand_description unless $self->{atomicCheckin};
+
+ return $self->{atomicCheckin}
+} # atomicCheckin
+
+sub group() {
+
+=pod
+
+=head2 group
+
+Returns the VOB group
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB group
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ my ($self) = @_;
+
+ $self->expand_description unless $self->{group};
+
+ return $self->{group}
+} # group
+
+sub groups() {
+
+=pod
+
+=head2 groups
+
+Returns the VOB groups
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB groups
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ my ($self) = @_;
+
+ $self->expand_description unless $self->{groups};
+
+ return @{$self->{groups}}
+} # groups
+
+sub aclsEnabled() {
+
+=pod
+
+=head2 aclsEnabled
+
+Returns the VOB aclsEnabled
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB aclsEnabled
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ my ($self) = @_;
+
+ $self->expand_description unless $self->{aclsEnabled};
+
+ return $self->{aclsEnabled}
+} # aclsEnabled
+
+sub attributes() {
+
+=pod
+
+=head2 attributes
+
+Returns the VOB attributes
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB attributes
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ my ($self) = @_;
+
+ $self->expand_description unless $self->{attributes};
+
+ return %{$self->{attributes}};
+} # attributes
+
+sub hyperlinks() {
+
+=pod
+
+=head2 hyperlinks
+
+Returns the VOB hyperlinks
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB hyperlinks
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ my ($self) = @_;
+
+ $self->expand_description unless $self->{hyperlinks};
+
+ return %{$self->{hyperlinks}};
+} # hyperlinks
+
sub countdb () {
my ($self) = @_;
chomp @output;
# Parse output
- foreach (@output) {
+ for (@output) {
if (/^ELEMENT\s*:\s*(\d*)/) {
$self->{elements} = $1;
} elsif (/^BRANCH\s*:\s*(\d*)/) {
} elsif (/^VERSION\s*:\s*(\d*)/) {
$self->{versions} = $1;
} # if
- } # foreach
+ } # for
chdir $cwd;
# use the create method on, return our blessings...
return if $status != 0;
- foreach (@output) {
+ for (@output) {
if (/Global path: (.*)/) {
$self->{gpath} = $1;
} elsif (/Server host: (.*)/) {
} elsif (/Vob registry attributes: (.*)/) {
$self->{vob_registry_attributes} = $1;
} # if
- } # foreach
+ } # for
return;
} # getVobInfo
use Display;
use OSDep;
-sub new () {
- my ($class) = @_;
+sub new (;$) {
+ my ($class, $host, $region) = @_;
=pod
-=head2 new (tag)
+=head2 new (host)
Construct a new Clearcase Vobs object.
=over
-=item none
+=item host
+
+If host is specified then limit the vob list to only those vobs on that host. If
+host is not specified then all vobs are considered
=back
=cut
- my ($status, @output) = $Clearcase::CC->execute ("lsvob -short");
+ my $cmd = 'lsvob -short';
+ $cmd .= " -host $host" if $host;
+ $cmd .= " -region $region" if $region;
- return if $status;
+ my ($status, @output) = $Clearcase::CC->execute ($cmd);
- # Strip $VOBTAG_PREFIX
- foreach (@output) {
- if ($ARCHITECTURE eq 'windows' or $ARCHITECTURE eq 'cygwin') {
- s/\\//;
- } else {
- s/$Clearcase::VOBTAG_PREFIX//;
- } # if
- } # foreach
+ return if $status;
return bless {
vobs => \@output
use Utils;
use Term::ReadLine;
-use Term::ANSIColor qw(color);
+use Term::ANSIColor qw (color);
# Package globals
my $_pos = 0;
my $_haveGnu;
-my $promptColor = color('bold yellow');
-my $inputColor = color('underline');
-my $resetColor = color('reset');
-
-my (%_cmds, $_attribs);
-
-our $_cmdline;
+my (%_cmds, $_cmdline, $_attribs);
BEGIN {
# See if we can load Term::ReadLine::Gnu
} # BEGIN
# Share %opts
-our %opts = (
- color => 1,
-);
+our %opts;
my %builtin_cmds = (
history => {
},
);
-sub _cmdCompletion($$) {
+sub _cmdCompletion ($$) {
my ($text, $state) = @_;
return unless %_cmds;
return;
} # _cmdCompletion
-sub _complete($$$$) {
+sub _complete ($$$$) {
my ($text, $line, $start, $end) = @_;
return $_cmdline->completion_matches ($text, \&CmdLine::_cmdCompletion);
} # _complete
-sub _gethelp() {
+sub _gethelp () {
my ($self) = @_;
return unless %_cmds;
# Sometimes we are called by ReadLine's callback and can't pass $self
if (ref $self eq 'CmdLine') {
- $self->help($line);
+ $self->help ($line);
} else {
- $CmdLine::cmdline->help($line);
- } # if
+ $CmdLine::cmdline->help ($line);
+ } # if
$_cmdline->on_new_line;
} # _gethelp
my ($self, $str) = @_;
# Skip interpolation for the perl command (Note this is raid specific)
- return $str if $str =~ /^\s*perl\s*/i;
+ return $str
+ if $str =~ /^\s*perl\s*/i;
while ($str =~ /\$/) {
if ($str =~ /\$(\w+)/) {
my $varname = $1;
- if ($self->{vars}{$varname}) {
- if ($self->{vars}{$varname} =~ / /) {
- $str =~ s/\$$varname/\'$self->{vars}{$varname}\'/;
- } else {
+ if (defined $self->{vars}{$varname}) {
+ if ($self->{vars}{$varname} =~ / /) {
+ $str =~ s/\$$varname/\'$self->{vars}{$varname}\'/;
+ } else {
$str =~ s/\$$varname/$self->{vars}{$varname}/;
- } # if
+ } # if
} else {
- $str =~ s/\$$varname//;
+ $str =~ s/\$$varname//;
} # if
} # if
} # while
return $str;
} # _interpolate
-sub _builtinCmds($) {
+sub _builtinCmds ($) {
my ($self, $line) = @_;
unless (defined $line) {
system $1;
} # if
- #$_cmdline->remove_history($_cmdline->where_history);
+ #$_cmdline->remove_history ($_cmdline->where_history);
return;
} # if
$cmd = $1;
} # if
- return unless $cmd;
+ return
+ unless $cmd;
my @parms;
# Search for matches of partial commands
my $foundCmd;
- for (keys %builtin_cmds) {
+ for (keys %builtin_cmds) {
if ($_ eq $cmd) {
# Exact match - honor it
$foundCmd = $cmd;
if ($builtin_cmds{$cmd}) {
if ($line =~ /^\s*help\s*(.*)/i) {
if ($1 =~ /(.+)$/) {
- $self->help($1);
+ $self->help ($1);
} else {
$self->help;
} # if
if ($1 =~ /(\d+)\s+(\d+)\s*$/) {
$self->history ('list', $1, $2);
} elsif ($1 =~ /^\s*$/) {
- $self->history('list');
+ $self->history ('list');
} else {
error "Invalid usage";
- $self->help('history');
+ $self->help ('history');
} # if
} elsif ($line =~ /^\s*savehist\s*(.*)/i) {
if ($1 =~ /(\S+)\s+(\d+)\s+(\d+)\s*$/) {
- $self->history('save', $1, $2, $3);
+ $self->history ('save', $1, $2, $3);
} else {
error 'Invalid usage';
- $self->help('savehist');
+ $self->help ('savehist');
} # if
} elsif ($line =~ /^\s*get\s*(.*)/i) {
if ($1 =~ (/^\$*(\S+)\s*$/)) {
- my $value = $self->_get($1);
-
+ my $value = $self->_get ($1);
+
if ($value) {
display "$1 = $value";
} else {
} # if
} else {
error 'Invalid usage';
- $self->help('get');
+ $self->help ('get');
} # if
} elsif ($line =~ /^\s*set\s*(.*)/i) {
if ($1 =~ /^\$*(\S+)\s*=\s*(.*)/) {
- $self->_set($1, $2)
+ $self->_set ($1, $2)
} else {
error 'Invalid usage';
- $self->help('set');
+ $self->help ('set');
} # if
} elsif ($line =~ /^\s*source\s+(\S+)/i) {
$result = $self->source ($1);
} elsif ($line =~ /^\s*color\s*(.*)/i) {
if ($1 =~ /(1|on)/i) {
$opts{color} = 1;
- delete $ENV{ANSI_COLORS_DISABLED} if $ENV{ANSI_COLORS_DISABLED};
- $self->set_prompt;
+ delete $ENV{ANSI_COLORS_DISABLED}
+ if $ENV{ANSI_COLORS_DISABLED};
} elsif ($1 =~ /(0|off)/i) {
- $opts{color} = 0;
+ $opts{trace} = 0;
$ENV{ANSI_COLORS_DISABLED} = 1;
- $self->set_prompt;
} elsif ($1 =~ /\s*$/) {
if ($ENV{ANSI_COLORS_DISABLED}) {
display 'Color is currently off';
} # if
} else {
error 'Invalid usage';
- $self->help('color');
+ $self->help ('color');
} # if
} elsif ($line =~ /^\s*trace\s*(.*)/i) {
if ($1 =~ /(1|on)/i) {
} # if
} else {
error 'Invalid usage';
- $self->help('trace');
+ $self->help ('trace');
} # if
} # if
} # if
sub _interrupt () {
# Announce that we have hit an interrupt
- print color('yellow') . "<Control-C>\n" . color('reset');
+ print color ('yellow') . "<Control-C>\n" . color ('reset');
# Free up all of the line state info
$_cmdline->free_line_state;
return;
} # _interrupt
-sub _displayMatches($$$) {
+sub _displayMatches ($$$) {
my ($matches, $numMatches, $maxLength) = @_;
-
+
# Work on a copy... (Otherwise we were getting "Attempt to free unreferenced
# scalar" internal errors from perl)
my @Matches;
- push @Matches, $_ for (@$matches);
+ push @Matches, $_ for (@$matches);
my $match = shift @Matches;
unshift @newMatches, $match;
- $_cmdline->display_match_list(\@newMatches);
+ $_cmdline->display_match_list (\@newMatches);
$_cmdline->on_new_line;
$_cmdline->redisplay;
return;
} # _displayMatches
-
-sub new(;$$%) {
+
+sub new (;$$%) {
my ($class, $histfile, $eval, %cmds) = @_;
=pod
} # unless
# Instantiate a commandline
- $_cmdline = Term::ReadLine->new($me);
+ $_cmdline = Term::ReadLine->new ($me);
# Store the function pointer of what to call when sourcing a file or
# evaluating an expression.
} # if
} # if
- $self->{promptColor} = $promptColor;
- $self->{inputColor} = $inputColor;
- $self->{resetColor} = $resetColor;
-
# Default prompt is "$me:"
- $self->set_prompt("$me:");
+ $self->{prompt} = "$me:";
# Set commands
- $self->set_cmds(%cmds);
+ $self->set_cmds (%cmds);
# Set some ornamentation
- $_cmdline->ornaments('e,,u') unless $Config{cppflags} =~ /win32/i;
+ $_cmdline->ornaments ('s,e,u,') unless $Config{cppflags} =~ /win32/i;
# Read in history
- $self->set_histfile($histfile);
+ $self->set_histfile ($histfile);
# Generator function for completion matches
$_attribs = $_cmdline->Attribs;
# The following functionality requires Term::ReadLine::Gnu
if ($_haveGnu) {
# Bind a key to display completion
- $_cmdline->add_defun('help-on-command', \&CmdLine::_gethelp, ord ("\cl"));
+ $_cmdline->add_defun ('help-on-command', \&CmdLine::_gethelp, ord ("\cl"));
# Save a handy copy of RL_PROMPT_[START|END]_IGNORE
$self->{ignstart} = $_cmdline->RL_PROMPT_START_IGNORE;
return $self;
} # new
-sub get() {
+sub get () {
my ($self) = @_;
=pod
$prompt =~ s/\\\#/$self->{cmdnbr}/g;
- # Now color it if color is on
- $prompt = "$self->{resetColor}$self->{promptColor}$prompt$self->{resetColor}$self->{inputColor}" if $self->{promptColor};
-
use POSIX;
# Term::ReadLine::Gnu restarts whatever system call it is using, such that
$oldaction = POSIX::SigAction->new;
# Set up our unsafe signal handler
- POSIX::sigaction(&POSIX::SIGINT, $sigaction, $oldaction);
+ POSIX::sigaction (&POSIX::SIGINT, $sigaction, $oldaction);
} # if
- $line = $_cmdline->readline($prompt);
-
- display_nolf $resetColor;
+ $line = $_cmdline->readline ($prompt);
# Restore the old signal handler
if ($Config{cppflags} !~ /win32/i) {
- POSIX::sigaction(&POSIX::SIGINT, $oldaction);
+ POSIX::sigaction (&POSIX::SIGINT, $oldaction);
} # if
- $line = $self->_interpolate($line) if $line;
+ $line = $self->_interpolate ($line)
+ if $line;
- $self->{cmdnbr}++ unless $self->{sourcing};
+ $self->{cmdnbr}++
+ unless $self->{sourcing};
- ($cmd, $line, $result) = $self->_builtinCmds($line);
+ ($cmd, $line, $result) = $self->_builtinCmds ($line);
- $line = '' unless $cmd;
+ $line = ''
+ unless $cmd;
} while ($cmd and $builtin_cmds{$cmd});
- if (wantarray) {
- return ($line, $result);
- } else {
- return $result || $line;
- } # if
+ return ($line, $result);
} # get
sub set_cmds (%) {
=cut
- my $oldPrompt = $self->{prompt};
-
- $self->{prompt} = $prompt if $prompt;
+ my $return = $self->{prompt};
- if ($opts{color}) {
- $self->{promptColor} = $promptColor;
- $self->{resetColor} = $resetColor;
- } else {
- undef $self->{promptColor};
- undef $self->{resetColor};
- } # if
+ $self->{prompt} = $prompt;
- return $oldPrompt;
+ return $return;
} # set_prompt
-sub set_histfile($) {
+sub set_histfile ($) {
my ($self, $histfile) = @_;
=pod
$_cmdline->clear_history;
# Now read histfile
- $_cmdline->ReadHistory($histfile);
+ $_cmdline->ReadHistory ($histfile);
} # if
# Determine the number of lines in the history file
return;
} # set_histfile
-sub set_eval(;\&) {
+sub set_eval (;\&) {
my ($self, $eval) = @_;
=pod
return $returnEval;
} # set_eval
-sub help(;$) {
+sub help (;$) {
my ($self, $cmd) = @_;
=pod
if (/$searchStr/i) {
$helpFound = 1;
- my $cmdcolor = $builtin_cmds{$_} ? color('cyan') : color ('magenta');
- my $boldOn = $builtin_cmds{$_} ? color('white on_cyan') : color ('white on_magenta');
- my $boldOff = color('reset') . $cmdcolor;
+ my $cmdcolor = $builtin_cmds{$_} ? color ('cyan') : color ('magenta');
+ my $boldOn = $builtin_cmds{$_} ? color ('white on_cyan') : color ('white on_magenta');
+ my $boldOff = color ('reset') . $cmdcolor;
$cmd = "$cmdcolor$_";
$cmd =~ s/($searchStr)/$boldOn$1$boldOff/g;
} # for
} # if
- $self->handleOutput($cmd, @help);
+ $self->handleOutput ($cmd, @help);
return;
} # help
-sub history(;$) {
+sub history (;$) {
my ($self, $action) = @_;
=pod
$start = $_[3];
$end = $_[4];
} elsif ($action eq 'redo') {
- $_cmdline->remove_history($_cmdline->where_history);
+ $_cmdline->remove_history ($_cmdline->where_history);
my $nbr = $_[2];
- my $line = $_cmdline->history_get($nbr);
+ my $line = $_cmdline->history_get ($nbr);
- $_cmdline->add_history($line);
+ $_cmdline->add_history ($line);
display $line;
- my ($cmd, $result) = $self->_builtinCmds($line);
+ my ($cmd, $result) = $self->_builtinCmds ($line);
if ($builtin_cmds{$cmd}) {
return;
return;
} # history
-sub _get($$) {
+sub _get ($$) {
my ($self, $name) = @_;
=pod
-=head2 _get($name)
+=head2 _get ($name)
This method gets a variable to a value stored in the CmdLine
object.
return $self->{vars}{$name}
} # _get
-sub _set($$) {
+sub _set ($$) {
my ($self, $name, $value) = @_;
=pod
my $returnValue = $self->{vars}{$name};
- if ($value) {
- $value = $self->_interpolate($value);
+ if (defined $value) {
+ $value = $self->_interpolate ($value);
# Do not call eval if we are setting result - otherwise we recurse
# infinitely.
unless ($name eq 'result') {
no strict;
- $value = $self->{eval}($value)
+ $value = $self->{eval} ($value)
if $self->{eval};
use strict;
} # unless
return $returnValue;
} # _set
-sub vars($) {
+sub vars ($) {
my ($self, $cmd) = @_;
=pod
-=head2 vars($name)
+=head2 vars ($name)
This method will print out all known variables
push @output, "$_ = $self->{vars}{$_}"
for (keys %{$self->{vars}});
- $self->handleOutput($cmd, @output);
+ $self->handleOutput ($cmd, @output);
} # vars
-sub handleOutput($@) {
+sub handleOutput ($@) {
my ($self, $line, @output) = @_;
=pod
local $SIG{PIPE} = 'IGNORE';
- open $pipe, '|', $pipeToCmd or undef $pipe;
+ open $pipe, '|', $pipeToCmd
+ or undef $pipe;
# TODO: Not handling the output here. Need open2 and then recursively call
# handleOutput.
if ($pipe) {
- print $pipe "$_\n" for (@output);
+ print $pipe "$_\n"
+ for (@output);
- close $pipe or error "Unable to close pipe for $pipeToCmd - $!";
+ close $pipe
+ or error "Unable to close pipe for $pipeToCmd - $!";
} else {
error "Unable to open pipe for $pipeToCmd - $!";
} # if
open my $output, '>', $outToFile;
if ($output) {
- print $output "$_\n" for (@output);
+ print $output "$_\n"
+ for (@output);
close $output;
return;
} # handleOutput
-sub source($) {
+sub source ($) {
my ($self, $file) = @_;
=pod
$_ = $self->_interpolate ($_);
# Check to see if it's a builtin
- my ($cmd, $line, $result) = $self->_builtinCmds($_);
+ my ($cmd, $line, $result) = $self->_builtinCmds ($_);
next if $builtin_cmds{$cmd};
no strict;
- $result = $self->{eval}($line);
+ $result = $self->{eval} ($line);
use strict;
if (defined $result) {
sub DESTROY {
my ($self) = @_;
- $_cmdline->WriteHistory($self->{histfile})
+ $_cmdline->WriteHistory ($self->{histfile})
if $_cmdline and $_haveGnu;
return;
=cut
- open my $pipe, '|-', $to
+ open my $pipe, '|', $to
or error "Unable to open pipe - $!", 1;
foreach (@output) {
source /etc/bash_completion
fi
-# Alias ping
+# Windows aliases
if [ $ARCHITECTURE = "cygwin" ]; then
alias ping=$(echo $SYSTEMROOT | tr '\\' '\/')/system32/ping
+ alias rdp=mstsc
fi
# We specify /home/$USER here so that when we sudo to another user
# Common CDPATHS
export CT=/cleartrig/ent/SNSD/muos/ccadm_tools/vobs/ranccadm/scripts
CDPATH=$CDPATH:/vobs/ranccadm:$CT
-
diff=auto
branch=auto
+[diff]
+ tool = meld
+
+[difftool]
+ prompt = false
+
+[difftool "meld"]
+ cmd = meld "$LOCAL" "$REMOTE"
+
# Currently these are restating the default
[color "branch"]
current=green
remote=red
[color "diff"]
- external = /usr/local/bin/git-meld
+ external = /bin/meld
[color "status"]
added=yellow
--- /dev/null
+#!/usr/bin/env perl\r
+\r
+use strict;\r
+use warnings;\r
+\r
+use FindBin;\r
+use lib "$FindBin::Bin/../lib";\r
+\r
+use Display;\r
+use CmdLine;\r
+\r
+sub _is_leap_year($) {\r
+ my ($year) = @_;\r
+\r
+ return 0 if $year % 4;\r
+ return 1 if $year % 100;\r
+ return 0 if $year % 400;\r
+\r
+ return 1; \r
+} # _is_leap_year\r
+\r
+sub MDYHMS2SQLDatetime($) {\r
+ my ($datetime) = @_;\r
+\r
+ $datetime =~ s/^\s+|\s+$//g;\r
+\r
+ my ($year, $mon, $day, $hour, $min, $sec, $ampm);\r
+\r
+ # For datetime format of MM/DD/YYYY HH:MM:SS [Am|Pm]\r
+ if ($datetime =~ /^(\d{1,2})\/(\d{1,2})\/(\d{4}) (\d{1,2}):(\d{1,2}):(\d{1,2}) (\w{2})$/) {\r
+ $mon = $1;\r
+ $day = $2;\r
+ $year = $3;\r
+ $hour = $4;\r
+ $min = $5;\r
+ $sec = $6;\r
+ $ampm = $7;\r
+ # For datetime format of MM/DD/YYYY HH:MM:SS\r
+ } elsif ($datetime =~ /^(\d{1,2})\/(\d{1,2})\/(\d{4}) (\d{1,2}):(\d{1,2}):(\d{1,2})$/){\r
+ $mon = $1;\r
+ $day = $2;\r
+ $year = $3;\r
+ $hour = $4;\r
+ $min = $5;\r
+ $sec = $6;\r
+ # For datetime format of MM/DD/YYYY\r
+ } elsif ($datetime =~ /^(\d{1,2})\/(\d{1,2})\/(\d{4})$/) {\r
+ $mon = $1;\r
+ $day = $2;\r
+ $year = $3;\r
+ $hour = '00';\r
+ $min = '00';\r
+ $sec = '00';\r
+ } else {\r
+ return\r
+ } # if\r
+\r
+ # Range checks\r
+ return if $mon > 12 or $mon <= 0;\r
+ return if $day > 31 or $day <= 0;\r
+ return if $hour > 23 or $hour < 0;\r
+ return if $min > 59 or $min < 0;\r
+\r
+ if ($day >= 31 and ($mon == 2\r
+ or $mon == 4\r
+ or $mon == 6\r
+ or $mon == 9\r
+ or $mon == 11)) {\r
+ return;\r
+ } # if\r
+\r
+ return if $day > 29 and $mon == 2;\r
+ return if $day == 29 and $mon == 2 and not _is_leap_year($year);\r
+\r
+ # Convert to 24 hour time if necessary\r
+ $hour += 12 if $ampm and $ampm =~ /pm/i;\r
+\r
+ # Add any leading zeros\r
+ $mon = "0$mon" if length $mon == 1;\r
+ $day = "0$day" if length $day == 1;\r
+ $hour = "0$hour" if length $hour == 1;\r
+ $min = "0$min" if length $min == 1;\r
+ $sec = "0$sec" if length $sec == 1;\r
+\r
+ return "$year-$mon-$day $hour:$min:$sec";\r
+} # MDYHMS2SQLDatetime\r
+\r
+local $| = 1;\r
+\r
+$CmdLine::cmdline->set_prompt('Enter datetime:');\r
+\r
+while () {\r
+ my $datetime = $CmdLine::cmdline->get;\r
+\r
+ last unless defined $datetime;\r
+ last if $datetime =~ /(exit|quit|e|q)/i;\r
+\r
+ if ($datetime) {\r
+ my $newdatetime = MDYHMS2SQLDatetime $datetime;\r
+\r
+ if ($newdatetime) {\r
+ display $newdatetime;\r
+ } else {\r
+ error "Date $datetime is invalid";\r
+ } # if\r
+ } # if\r
+} # while\r