Hopefully fixed the ._hist problem.
Major improvements to CmdLine.pm
New subroutine for Dateutils.pm
-#!/usr/bin/perl
+#!/usr/bin/env perl
use strict;
use warnings;
=item Revision
-$Revision: 1.0 $
+$Revision: 2.0 $
=item Created:
Usage: rexec.pl [-usa|ge] [-h|elp] [-v|erbose] [-d|ebug]
[-use|rname <username>] [-p|assword <password>]
[-log]
- -m|achines <host1>,<host2>,...
+ [-m|achines <host1>,<host2>,...]
+ [-f|ile <machines>]
<command>
-use|rname: User name to login as (Default: $USER - Env: REXEC_USER)
-p|assword: Password to use (Default: None - Env: REXEC_PASSWD)
-m|achines: Machine(s) to run the command on
+ -f|ile: File containing machine info
-l|og: Log output (<machine>.log)
<command>: Commands to execute (Enclose multiple commands in quotes)
debug => sub { set_debug },
username => $ENV{REXEC_USER} || $ENV{USER},
password => $ENV{REXEC_PASSWD},
- filename => $ENV{REXEC_MACHINES_FILE} || '/opt/clearscm/data/machines',
+ database => 1,
);
sub Interrupted {
use Term::ReadKey;
- display BLUE . "\nInterrupted execution on $currentHost->{host}" . RESET;
+ my $host = $currentHost->{host} || 'Unknown Host';
- display_nolf "Executing on " . YELLOW . $currentHost->{host} . RESET . " - "
+ display BLUE . "\nInterrupted execution on $host" . RESET;
+
+ display_nolf "Executing on " . CYAN . $host . RESET . " - "
. CYAN . BOLD . "C" . RESET . CYAN . "ontinue" . RESET . " or "
. MAGENTA . BOLD . "A" . RESET . MAGENTA . "bort run" . RESET . " ("
. CYAN . BOLD . "C" . RESET . "/"
if ($answer eq "s") {
*STDOUT->flush;
- display "Skipping $currentHost->{host}";
+ display "Skipping $host";
} elsif ($answer eq "a") {
display RED . "Aborting run". RESET;
exit;
sub connectHost ($) {
my ($host) = @_;
- # Start a log...
- $log = Logger->new (name => $host) if $opts{log};
-
eval {
$currentHost = Rexec->new (
host => $host,
return;
} # connectHost
+sub initLog($) {
+ my ($machine) = @_;
+
+ if ($opts{log}) {
+ my $logdir = $opts{logdir} ? "$opts{logdir}/$machine" : $machine;
+
+ mkdir $logdir or error "Unable to make directory $logdir", 1;
+
+ $log = Logger->new(
+ name => 'output',
+ path => $logdir,
+ );
+ } # if
+} # initLog
+
+sub Log($;$) {
+ my ($msg, $nocrlf) = @_;
+
+ if ($log) {
+ $log->msg($msg, $nocrlf);
+ } else {
+ verbose $msg, $nocrlf;
+ } #
+} # Log
+
+sub logError ($;$) {
+ my ($msg, $exit) = @_;
+
+ if ($log) {
+ $log->err($msg, $exit);
+ } else {
+ error $msg, $exit;
+ } # if
+} # logError
+
sub execute ($$;$) {
my ($host, $cmd, $prompt) = @_;
my @lines;
- verbose_nolf "Connecting to machine $host...";
+ Log "Connecting to machine $host...", 1;
- display_nolf BOLD . YELLOW . "$host:" . RESET if $opts{verbose};
+ display_nolf BOLD . CYAN . "$host:" . RESET if $opts{verbose};
connectHost $host unless $currentHost and $currentHost->{host} eq $host;
return (1, ()) unless $currentHost;
- verbose " connected";
+ Log ' connected';
- display WHITE . UNDERLINE . "$cmd" . RESET if $opts{verbose};
+ Log "$host:" . UNDERLINE . $cmd . RESET;
@lines = $currentHost->execute ($cmd);
- verbose "Disconnected from $host";
-
my $status = $currentHost->status;
return ($status, @lines);
'log',
'logdir',
'filename=s',
- 'database',
+ 'database!',
'machines=s@',
+ 'condition=s',
) or pod2usage;
$opts{debug} = get_debug if ref $opts{debug} eq 'CODE';
my $cmd = join ' ', @ARGV;
+$opts{machines} = [$ENV{REXEC_HOST}] if $ENV{REXEC_HOST};
+
unless ($opts{machines}) {
- $opts{machines} = [$ENV{REXEC_HOST}] if $ENV{REXEC_HOST};
-} # unless
+ # Connect to Machines module
+ my $machines;
-# Connect to Machines module
-my $machines;
+ unless ($opts{database}) {
+ require Machines; Machines->import;
-unless ($opts{database}) {
- require Machines; Machines->import;
+ $machines = Machines->new(filename => $opts{filename});
+ } else {
+ require Machines::MySQL; Machines::MySQL->import;
- $machines = Machines->new(filename => $opts{filename});
-} else {
- require Machines::MySQL; Machines::MySQL->import;
+ $machines = Machines::MySQL->new;
- $machines = Machines::MySQL->new;
-} # if
+ my %machines = $machines->select($opts{condition});
-my %machines = $machines->select;
+ $opts{machines} = [keys %machines];
+ } # if
+} # if
my ($status, @lines);
-for my $machine (sort keys %machines) {
+for my $machine (sort @{$opts{machines}}) {
+ initLog $machine;
+
if ($cmd) {
($status, @lines) = execute $machine, $cmd;
- display BOLD . YELLOW . "$machine:" . RESET . WHITE . $cmd;
+ display BOLD . CYAN . "$machine:" . UNDERLINE . WHITE . $cmd . RESET;
+
+ logError "Execution of $cmd on $machine failed", $status if $status;
- error "Execution of $cmd on $machine yielded error $status" if $status;
+ if ($log) {
+ $log->log($_) for @lines;
+ } # if
display $_ for @lines;
undef $currentHost;
+ undef $log;
} else {
verbose_nolf "Connecting to machine $machine...";
if ($currentHost) {
my $cmdline = CmdLine->new ();
- $cmdline->set_prompt (BOLD . YELLOW . "$machine:" . RESET . WHITE);
+ $cmdline->set_prompt (BOLD . CYAN . "$machine:" . RESET . WHITE);
while () {
- #$cmd = <STDIN>;
+ Log "$machine:";
+
$cmd = $cmdline->get();
unless ($cmd) {
+ $log->msg('') if $log;
display '';
last;
} # unless
chomp $cmd;
+ Log $cmd;
+
($status, @lines) = execute $machine, $cmd;
- error "Execution of $cmd on $machine yielded error $status" if $status;
+ logError "Execution of $cmd on $machine failed", $status if $status;
+ Log $_ for @lines;
display $_ for @lines;
} # while
} # if
+
+ undef $log;
} # if
} # for
# Column 4 ClearCase Version (if applicable)
# Column 5 Owner (if known)
# Column 6 Usage (if known)
-chargers:Sun:Solaris 5.9:7.0.1.1:ccadm:ranview1
-colts:Sun:Solaris 5.9:7.0.1.0:ccadm:ranview2
-cowboys:Sun:Solaris 5.9:7.0.1.0:ccadm:ranvob1/registry server
-niners:Sun:Solaris 5.9:2003.06.10+:ccadm:
-patriots:Sun:Solaris 5.9:7.0.1.0:ccadm:ranvob2
-rams:Sun:Solaris 5.9:7.0.1.0:ccadm:ranvob3/registry server
-#ranadm1:Sun:Solaris 5.9::ccadm:Jumpstart, PowerBroker, NIS, SMTP, DNS, NTP
-ranadm2:Sun:Solaris 5.9:2003.06.10+:ccadm:License server, Sys admin, NIS, Home Directory server
-ranbkp2::::ccadm:Backup
-ranbuild1:Sun:Solaris 5.8:7.0.1.0:ccadm:builds
-ranbuild2:Sun:Solaris 5.9:2003.06.10+:ccadm:builds
-ranbuild4:Sun:Solaris 5.9:7.0.1.1:ccadm:builds
-rancpp01:Redhat Linux:2.6.18.53.Eel5xen::ccadm:
-rancpp02:Redhat Linux:2.6.18.53.Eel5xen::ccadm:
-rancpp03:Redhat Linux:2.6.18.53.Eel5xen::ccadm:
-rancpp10:Redhat Linux:2.6.18.53.Eel5xen::ccadm:
-#randbs:Sun:Solaris 5.9::ccadm:CQ DB server/Bldforge
-randws094:Sun:Solaris 5.10:7.0.1.1:John Hartin:Old workstation
-randws103:Sun:Solaris 5.9:7.0.1.1::
-randws106:Sun:Solaris 5.9:2003.06.10+::
-randws113:Sun:Solaris 5.9:7.0.1.1::
-randws114:Sun:Solaris 5.9:2003.06.10+:Tony Trujilo:
-randws119:Sun:Solaris 5.9:7.0.1.1:Hy Truong:Workstation
-ranlin03:Redhat Linux:2.4.21-50.Elsmp::ccadm:
-ranray:Sun:Solaris 5.9:2003.06.10+:ccadm:
+rdeadm1:Oracle:Solaris 5.11:9.0.0:Tools Team:Primary Admin Server, NIS Master, DNS slave
+rdeadm2:Oracle:Solaris 5.11:9.0.0:Tools Team:Secondary Admin Server, home, NIS Slave, DNS Master, mail and prj
+rdevob1:Oracle:Solaris 5.11:9.0.0:Tools Team:Clearcase Vob Server 1
+rdevob2:Oracle:Solaris 5.11:9.0.0:Tools Team:Clearcase Vob Server 2
+rdeview1:Oracle:Solaris 5.11:9.0.0:Tools Team:Clearcase View Server
+rdebuild1:Oracle:Solaris 5.11:9.0.0:Tools Team:Build Server 1
+rdebuild2:Oracle:Solaris 5.11:9.0.0:Tools Team:Build Server 2
+rdebuild3:Oracle:Solaris 5.11:9.0.0:Tools Team:Build Server 3
+rdebuild4:Oracle:Solaris 5.11:9.0.0:Tools Team:Build Server 4
+rdedws000:Oracle:Solaris 5.11:9.0.0:Tools Team:Engineering Desktop
+rdedws033:Oracle:Solaris 5.11:9.0.0:Tools Team:Engineering Desktop
+rdedws035:Oracle:Solaris 5.11:9.0.0:Tools Team:Engineering Desktop
+rdedws036:Oracle:Solaris 5.11:9.0.0:Tools Team:Engineering Desktop
+rdedws094:Oracle:Solaris 5.11:9.0.0:Tools Team:Engineering Desktop
+rdedws103:Oracle:Solaris 5.11:9.0.0:Tools Team:Engineering Desktop
+rdedws106:Oracle:Solaris 5.11:9.0.0:Tools Team:Engineering Desktop
+rdedws113:Oracle:Solaris 5.11:9.0.0:Tools Team:Engineering Desktop
+rdedws114:Oracle:Solaris 5.11:9.0.0:Tools Team:Engineering Desktop
+rdedws119:Oracle:Solaris 5.11:9.0.0:Tools Team:Engineering Desktop
use Utils;
use Term::ReadLine;
-use Term::ANSIColor qw (color);
+use Term::ANSIColor qw(color);
# Package globals
my $_pos = 0;
my $_haveGnu;
-my (%_cmds, $_cmdline, $_attribs);
+my $promptColor = color('bold yellow');
+my $inputColor = color('underline');
+my $resetColor = color('reset');
+
+my (%_cmds, $_attribs);
+
+our $_cmdline;
BEGIN {
# See if we can load Term::ReadLine::Gnu
} # BEGIN
# Share %opts
-our %opts;
+our %opts = (
+ color => 1,
+);
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 (defined $self->{vars}{$varname}) {
- if ($self->{vars}{$varname} =~ / /) {
- $str =~ s/\$$varname/\'$self->{vars}{$varname}\'/;
- } else {
+ if ($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};
+ delete $ENV{ANSI_COLORS_DISABLED} if $ENV{ANSI_COLORS_DISABLED};
+ $self->set_prompt;
} elsif ($1 =~ /(0|off)/i) {
- $opts{trace} = 0;
+ $opts{color} = 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
my $me = get_me;
- $histfile ||= ".${me}_hist";
+ $histfile ||= "$ENV{HOME}/.${me}_hist";
error "Creating bogus .${me}_hist file!"
if $me eq '-' or $me eq '';
} # 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->{prompt} = "$me:";
+ $self->set_prompt("$me:");
# Set commands
- $self->set_cmds (%cmds);
+ $self->set_cmds(%cmds);
# Set some ornamentation
- $_cmdline->ornaments ('s,e,u,') unless $Config{cppflags} =~ /win32/i;
+ $_cmdline->ornaments('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);
+ $line = $_cmdline->readline($prompt);
+
+ display_nolf $resetColor;
# 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});
- return ($line, $result);
+ if (wantarray) {
+ return ($line, $result);
+ } else {
+ return $result || $line;
+ } # if
} # get
sub set_cmds (%) {
=cut
- my $return = $self->{prompt};
+ my $oldPrompt = $self->{prompt};
+
+ $self->{prompt} = $prompt if $prompt;
- $self->{prompt} = $prompt;
+ if ($opts{color}) {
+ $self->{promptColor} = $promptColor;
+ $self->{resetColor} = $resetColor;
+ } else {
+ undef $self->{promptColor};
+ undef $self->{resetColor};
+ } # if
- return $return;
+ return $oldPrompt;
} # 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 (defined $value) {
- $value = $self->_interpolate ($value);
+ if ($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;
use Display;
use Utils;
-our @EXPORT = qw (
+our @EXPORT = qw(
Add
Age
Compare
YMDHMS
timestamp
ymdhms
+ MDYHMS2SQLDatetime
);
my @months = (
my $SECS_IN_DAY = $SECS_IN_HOUR * 24;
# Forwards
-sub Today2SQLDatetime ();
-sub DateToEpoch ($);
-sub EpochToDate ($);
+sub Today2SQLDatetime();
+sub DateToEpoch($);
+sub EpochToDate($);
-sub ymdhms {
+sub ymdhms(;$) {
my ($time) = @_;
$time ||= time;
$wday,
$yday,
$isdst
- ) = localtime ($time);
+ ) = localtime($time);
# Adjust month
$mon++;
return $year, $mon, $mday, $hour, $min, $sec;
} # ymdhms
-sub julian ($$$) {
+sub julian($$$) {
my ($year, $month, $day) = @_;
my $days = 0;
return $days + $day;
} # julian
-sub _is_leap_year ($) {
+sub _is_leap_year($) {
my ($year) = @_;
-
+
return 0 if $year % 4;
return 1 if $year % 100;
return 0 if $year % 400;
-
+
return 1;
} # _is_leap_year
-sub Add ($%) {
+sub Add($%) {
my ($datetime, %parms) = @_;
-
+
=pod
=head2 Add ($datetime, %parms)
hours => $hours
days => $days
month => $month
-
+
Note that month will simply increment the month number, adjusting for overflow
of year if appropriate. Therefore a date of 2/28/2001 would increase by 1 month
to yield 3/28/2001. And, unfortunately, an increase of 1 month to 1/30/2011
'days',
'months',
);
-
- foreach (keys %parms) {
- unless (InArray ($_, @validKeys)) {
+
+ for (keys %parms) {
+ unless (InArray($_, @validKeys)) {
croak "Invalid key in DateUtils::Add: $_";
} # unless
- } # foreach
-
+ } # for
+
my $epochTime = DateToEpoch $datetime;
-
+
my $amount = 0;
-
+
$parms{seconds} ||= 0;
$parms{minutes} ||= 0;
$parms{hours} ||= 0;
$parms{days} ||= 0;
-
+
$amount += $parms{days} * $SECS_IN_DAY;
$amount += $parms{hours} * $SECS_IN_HOUR;
$amount += $parms{minutes} * $SECS_IN_MIN;
$amount += $parms{seconds};
-
+
$epochTime += $amount;
$datetime = EpochToDate $epochTime;
-
+
if ($parms{month}) {
my $years = $parms{month} / 12;
my $months = $parms{month} % 12;
-
+
my $month = substr $datetime, 5, 2;
-
+
$years += ($month + $months) / 12;
- substr ($datetime, 5, 2) = ($month + $months) % 12;
-
- substr ($datetime, 0, 4) = substr ($datetime, 0, 4) + $years;
+ substr($datetime, 5, 2) = ($month + $months) % 12;
+
+ substr($datetime, 0, 4) = substr ($datetime, 0, 4) + $years;
} # if
-
+
return $datetime;
} # Add
-sub Age ($) {
+sub Age($) {
my ($timestamp) = @_;
=pod
my $timestamp_days = julian $timestamp_year, $month, $day;
if ($timestamp_year > $today_year or
- ($timestamp_days > $today_days and $timestamp_year == $today_year)) {
+ ($timestamp_days > $today_days and $timestamp_year == $today_year)) {
return;
} else {
my $leap_days = 0;
for (my $i = $timestamp_year; $i < $today_year; $i++) {
-
+
$leap_days++ if $i % 4 == 0;
} # for
} # if
} # Age
-sub Compare ($$) {
+sub Compare($$) {
my ($date1, $date2) = @_;
-
+
=pod
=head2 Compare ($date2, $date2)
return DateToEpoch ($date1) <=> DateToEpoch ($date2);
} # Compare
-sub DateToEpoch ($) {
+sub DateToEpoch($) {
my ($date) = @_;
-
+
=pod
=head2 DateToEpoch ($datetime)
my $hour = substr $date, 11, 2;
my $minute = substr $date, 14, 2;
my $seconds = substr $date, 17, 2;
-
+
my $days;
for (my $i = 1970; $i < $year; $i++) {
$days += _is_leap_year ($i) ? 366 : 365;
} # for
-
+
my @monthDays = (
0,
31,
304,
334,
);
-
+
$days += $monthDays[$month - 1];
-
+
$days++
if _is_leap_year ($year) and $month > 2;
-
+
$days += $day - 1;
-
+
return ($days * $SECS_IN_DAY)
+ ($hour * $SECS_IN_HOUR)
+ ($minute * $SECS_IN_MIN)
+ $seconds;
} # DateToEpoch
-sub EpochToDate ($) {
+sub EpochToDate($) {
my ($epoch) = @_;
-
+
=pod
=head2 EpochToDate ($epoch)
my ($month, $day, $hour, $minute, $seconds);
my $leapYearSecs = 366 * $SECS_IN_DAY;
my $yearSecs = $leapYearSecs - $SECS_IN_DAY;
-
+
while () {
my $amount = _is_leap_year ($year) ? $leapYearSecs : $yearSecs;
-
+
last
if $amount > $epoch;
-
+
$epoch -= $amount;
$year++;
} # while
-
- my $leapYearAdjustment = _is_leap_year ($year) ? 1 : 0;
-
+
+ my $leapYearAdjustment = _is_leap_year($year) ? 1 : 0;
+
if ($epoch >= (334 + $leapYearAdjustment) * $SECS_IN_DAY) {
$month = '12';
$epoch -= (334 + $leapYearAdjustment) * $SECS_IN_DAY;
$month = '01';
} # if
- $day = int (($epoch / $SECS_IN_DAY) + 1);
+ $day = int(($epoch / $SECS_IN_DAY) + 1);
$epoch = $epoch % $SECS_IN_DAY;
- $hour = int ($epoch / $SECS_IN_HOUR);
+ $hour = int($epoch / $SECS_IN_HOUR);
$epoch = $epoch % $SECS_IN_HOUR;
- $minute = int ($epoch / $SECS_IN_MIN);
+ $minute = int($epoch / $SECS_IN_MIN);
$seconds = $epoch % $SECS_IN_MIN;
-
+
$day = "0$day" if $day < 10;
$hour = "0$hour" if $hour < 10;
$minute = "0$minute" if $minute < 10;
$seconds = "0$seconds" if $seconds < 10;
-
+
return "$year-$month-$day $hour:$minute:$seconds";
} # EpochToDate
-sub UTCTime ($) {
+sub UTCTime($) {
my ($datetime) = @_;
-
+
=pod
=head2 UTCTime ($epoch)
=cut
my @localtime = localtime;
- my ($sec, $min, $hour, $mday, $mon, $year) = gmtime (
+ my ($sec, $min, $hour, $mday, $mon, $year) = gmtime(
DateToEpoch ($datetime) - (timegm (@localtime) - timelocal (@localtime))
);
-
+
$year += 1900;
$mon++;
$hour = '0' . $hour if $hour < 10;
$mon = '0' . $mon if $mon < 10;
$mday = '0' . $mday if $mday < 10;
-
+
return "$year-$mon-${mday}T$hour:$min:${sec}Z";
} # UTCTime
-sub UTC2Localtime ($) {
+sub UTC2Localtime($) {
my ($utcdatetime) = @_;
-
+
# If the field does not look like a UTC time then just return it.
return $utcdatetime unless $utcdatetime =~ /\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}Z/;
);
} # UTC2Localtime
-sub FormatDate ($) {
+sub FormatDate($) {
my ($date) = @_;
=pod
. substr ($date, 0, 4);
} # FormatDate
-sub FormatTime ($) {
+sub FormatTime($) {
my ($time) = @_;
=pod
my $AmPm = $hours > 12 ? "Pm" : "Am";
$hours = $hours - 12 if $hours > 12;
-
+
$hours = "0$hours" if length $hours == 1;
return "$hours:$minutes $AmPm";
} # FormatTime
-sub MDY (;$) {
+sub MDY(;$) {
my ($time) = @_;
=pod
return "$mon/$mday/$year";
} # MDY
-sub SQLDatetime2UnixDatetime ($) {
+sub SQLDatetime2UnixDatetime($) {
my ($sqldatetime) = @_;
=pod
my $year = substr $sqldatetime, 0, 4;
my $month = substr $sqldatetime, 5, 2;
my $day = substr $sqldatetime, 8, 2;
- my $time = FormatTime (substr $sqldatetime, 11);
+ my $time = FormatTime(substr $sqldatetime, 11);
return $months{$month} . " $day, $year \@ $time";
} # SQLDatetime2UnixDatetime
-sub SubtractDays ($$) {
+sub SubtractDays($$) {
my ($timestamp, $nbr_of_days) = @_;
=pod
return $year . "-" . $month . "-" . $days . substr $timestamp, 10;
} # SubtractDays
-sub Today2SQLDatetime () {
+sub Today2SQLDatetime() {
=pod
return UnixDatetime2SQLDatetime (scalar (localtime));
} # Today2SQLDatetime
-sub UnixDatetime2SQLDatetime ($) {
+sub UnixDatetime2SQLDatetime($) {
my ($datetime) = @_;
=pod
unless ($months{$month_name}) {
$month_name = substr $datetime, 8, 3;
} # unless
-
+
my $month = $months{$month_name};
my $time = substr $datetime, 11, 8;
warning "Year undefined for $orig_datetime\nReturning today's date";
return Today2SQLDatetime;
} # unless
-
+
unless ($month) {
warning "Month undefined for $orig_datetime\nReturning today's date";
return Today2SQLDatetime;
} # unless
-
+
unless ($day) {
warning "Day undefined for $orig_datetime\nReturning today's date";
return Today2SQLDatetime;
return "$year-$month-$day $time";
} # UnixDatetime2SQLDatetime
-sub YMD (;$) {
+sub YMD(;$) {
my ($time) = @_;
=pod
return "$year$mon$mday";
} # YMD
-sub YMDHM (;$) {
+sub YMDHM(;$) {
my ($time) = @_;
=pod
return "$year$mon$mday\@$hour:$min";
} # YMDHM
-sub YMDHMS (;$) {
+sub YMDHMS(;$) {
my ($time) = @_;
=pod
return "$year$mon$mday\@$hour:$min:$sec";
} # YMDHMS
-sub timestamp (;$) {
+sub timestamp(;$) {
my ($time) = @_;
=pod
return "$year$mon${mday}_$hour$min$sec";
} # timestamp
+sub MDYHMS2SQLDatetime($) {
+ my ($datetime) = @_;
+
+ $datetime =~ s/^\s+|\s+$//g;
+
+ my ($year, $mon, $day, $hour, $min, $sec, $ampm);
+
+ # For datetime format of MM/DD/YYYY HH:MM:SS [Am|Pm]
+ if ($datetime =~ /^(\d{1,2})\/(\d{1,2})\/(\d{4}) (\d{1,2}):(\d{1,2}):(\d{1,2}) (\w{2})$/) {
+ $mon = $1;
+ $day = $2;
+ $year = $3;
+ $hour = $4;
+ $min = $5;
+ $sec = $6;
+ $ampm = $7;
+ # For datetime format of MM/DD/YYYY HH:MM:SS
+ } elsif ($datetime =~ /^(\d{1,2})\/(\d{1,2})\/(\d{4}) (\d{1,2}):(\d{1,2}):(\d{1,2})$/){
+ $mon = $1;
+ $day = $2;
+ $year = $3;
+ $hour = $4;
+ $min = $5;
+ $sec = $6;
+ # For datetime format of MM/DD/YYYY
+ } elsif ($datetime =~ /^(\d{1,2})\/(\d{1,2})\/(\d{4})$/) {
+ $mon = $1;
+ $day = $2;
+ $year = $3;
+ $hour = '00';
+ $min = '00';
+ $sec = '00';
+ } else {
+ return
+ } # if
+
+ # Range checks
+ return if $mon > 12 or $mon <= 0;
+ return if $day > 31 or $day <= 0;
+ return if $hour > 23 or $hour < 0;
+ return if $min > 59 or $min < 0;
+
+ if ($day >= 31 and ($mon == 2
+ or $mon == 4
+ or $mon == 6
+ or $mon == 9
+ or $mon == 11)) {
+ return;
+ } # if
+
+ return if $day > 29 and $mon == 2;
+ return if $day == 29 and $mon == 2 and not _is_leap_year($year);
+
+ # Convert to 24 hour time if necessary
+ $hour += 12 if $ampm and $ampm =~ /pm/i;
+
+ # Add any leading zeros
+ $mon = "0$mon" if length $mon == 1;
+ $day = "0$day" if length $day == 1;
+ $hour = "0$hour" if length $hour == 1;
+ $min = "0$min" if length $min == 1;
+ $sec = "0$sec" if length $sec == 1;
+
+ return "$year-$mon-$day $hour:$min:$sec";
+} # MDYHMS2SQLDatetime
+
1;
=head2 DEPENDENCIES
($VERSION) = ($VERSION =~ /\$Revision: (.*) /);\r
\r
my %MACHINEOPTS = (\r
- SERVER => 'localhost',\r
- USERNAME => 'machines',\r
- PASSWORD => 'w0rk$harder',\r
+ SERVER => $ENV{REXEC_DBHOST} || 'localhost',\r
+ USERNAME => 'rexec',\r
+ PASSWORD => 'rexec',\r
);\r
\r
+# Internal methods\r
sub _connect (;$) {\r
my ($self, $dbserver) = @_;\r
\r
return;\r
} # _checkRequiredFields\r
\r
-# Internal methods\r
sub _dberror ($$) {\r
my ($self, $msg, $statement) = @_;\r
\r
return $self->_addRecord ('system', %system);\r
} # AddSystem\r
\r
-1;
\ No newline at end of file
+1;\r
=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
+if [ $ARCHITECTURE = "cygwin" ]; then
+ alias ping=$(echo $SYSTEMROOT | tr '\\' '\/')/system32/ping
+fi
+
# We specify /home/$USER here so that when we sudo to another user
# we will only trap logout if that user also has a ~/.rc/logout
# (doubtfull).
export PERL5LIB=/cleartrig/ent/SNSD/muos/ccadm_tools/vobs/ranccadm/scripts/lib:$PERL5LIB
fi
-# This may need to be moved into bash_login
-if [ "$ARCHITECTURE" = "cygwin" ]; then
- alias ping=$SYSTEMROOT/System32/ping
-fi
-
export QTDIR="/usr/local/Trolltech/Qt-4.2.2"
export QMAKESPEC="$QTDIR/mkspecs/solaris-cc"
export ORACLE="SID rancq"
append_to_path "/cygdrive/c/Program Files (x86)/ibm/gsk8/lib"
# Common CDPATHS
-CDPATH=$CDPATH:/vobs/ranccadm
+export CT=/cleartrig/ent/SNSD/muos/ccadm_tools/vobs/ranccadm/scripts
+CDPATH=$CDPATH:/vobs/ranccadm:$CT
+
# Need to reset title since we put the branch name in the titlebar
git=$(which git)
- if [ "$1" = "checkout" -o "$1" = "co" ]; then
- $git $@
- set_title
- else
- $git $@
+ if [ "${git:0:3}" != "no " ]; then
+ if [ "$1" = "checkout" -o "$1" = "co" ]; then
+ $git $@
+ set_title
+ elif [ "$1" = "files" ]; then
+ if [ -z "$2" ]; then
+ echo "Files in git commit HEAD"
+ $git show --pretty="" --name-only HEAD
+ else
+ echo "Files in git commit $2"
+ $git show --pretty="" --name-only $2
+ fi
+ else
+ $git $@
+ fi
fi
} # git
projects / clearscm.git / commitdiff