Fixed bug to allow undefined extension to default to .log.

[clearscm.git] / lib / Utils.pm

diff --git a/lib/Utils.pm b/lib/Utils.pm
index 74c38fa..78af171 100644 (file)
--- a/lib/Utils.pm
+++ b/lib/Utils.pm
@@ -63,6 +63,7 @@ use base 'Exporter';
 use POSIX qw (setsid);
 use File::Spec;
 use Carp;
+use Term::ReadKey;
 
 use OSDep;
 use Display;
@@ -71,7 +72,9 @@ our @EXPORT = qw (
   EnterDaemonMode
   Execute
   GetChildren
+  GetPassword
   InArray
+  LoadAvg
   PageOutput
   PipeOutput
   PipeOutputArray
@@ -83,6 +86,15 @@ our @EXPORT = qw (
   Usage
 );
 
+sub _restoreTerm () {
+  # In case the user hits Ctrl-C
+  print "\nControl-C\n";
+
+  ReadMode 'normal';
+
+  exit;
+} # _restoreTerm
+
 sub EnterDaemonMode (;$$$) {
   my ($logfile, $errorlog, $pidfile) = @_;
 
@@ -130,14 +142,7 @@ Returns:
   $errorlog ||= $NULL;
 
   my $file;
-  
-  if ($pidfile) {
-    $pidfile =  File::Spec->rel2abs ($pidfile); 
 
-    open $file, '>', $pidfile
-      or warning "Unable to open pidfile $pidfile for writing - $!";  
-  } # if
-  
   # Redirect STDIN to $NULL
   open STDIN, '<', $NULL
     or error "Can't read $NULL ($!)", 1;
@@ -164,18 +169,23 @@ Returns:
 
   # Now the parent exits
   exit if $pid;
-  
+
   # Write pidfile if specified
   if ($pidfile) {
+    $pidfile =  File::Spec->rel2abs ($pidfile); 
+
+    open $file, '>', $pidfile
+      or warning "Unable to open pidfile $pidfile for writing - $!";  
+
     print $file "$$\n";
-    
+
     close $file; 
   } # if
-  
+
   # Set process to be session leader
   setsid ()
     or error "Can't start a new session ($!)", 1;
-    
+
   return;
 } # EnterDaemonMode
 
@@ -230,7 +240,7 @@ STDOUT then do so in the $command passed in.
 
   my @output = `$cmd`;
   my $status = $?;
-  
+
   local $SIG{CHLD} = $sigchld;
 
   chomp @output;
@@ -300,6 +310,79 @@ Returns:
   return @children;
 } # GetChildren
 
+sub GetPassword (;$) {
+  my ($prompt) = @_;
+
+=pod
+
+=head2 GetPassword (;$prompt)
+
+Prompt for a password
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item $prompt
+
+Prompt string to use (Default: "Password:")
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item $password
+
+=back
+
+=for html </blockquote>
+
+=cut  
+
+  
+  $prompt ||= 'Password';
+
+  my $password;
+
+  local $| = 1;
+
+  print "$prompt:";
+
+  $SIG{INT} = \&_restoreTerm;
+
+  ReadMode 'cbreak';
+
+  while () {
+    my $key;
+
+    while (not defined ($key = ReadKey -1)) { }
+
+    if ($key =~ /(\r|\n)/) {
+       print "\n";
+
+       last;
+    } # if
+
+    print '*';
+
+    $password .= $key;
+  } # while
+
+  ReadMode 'restore'; # Reset tty mode before exiting.
+
+  $SIG{INT} = 'DEFAULT';
+
+  return $password;
+} # GetPassword
+
 sub InArray ($@) {
   my ($item, @array) = @_;
 
@@ -348,6 +431,60 @@ Returns:
   return $FALSE;
 } # InArray
 
+sub LoadAvg () {
+
+=pod
+
+=head2 LoadAvg ()
+
+Return an array of the 1, 5, and 15 minute load averages.
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item An array of the 1, 5, and 15 minute load averages in a list context.
+In a scalar context just the 1 minute load average.
+
+=back
+
+=for html </blockquote>
+
+=cut  
+
+  # TODO: Make it work on Windows...
+  return if $^O =~ /win/i;
+
+  open my $loadAvg, '/proc/loadavg'
+    or croak "Unable to open /proc/loadavg\n";
+
+  my $load = <$loadAvg>;
+
+  close $loadAvg;
+
+  my @loadAvgs = split /\s/, $load;
+
+  if (wantarray) {
+    return @loadAvgs;
+  } else {
+    return $loadAvgs[0]; # This is the 1 minute average
+  }
+} # LoadAvg
+
 our $pipe;
 
 sub StartPipe ($;$) {
@@ -393,10 +530,10 @@ Returns:
 
   if ($existingPipe) {
     close $existingPipe;
-    
+
     open $existingPipe, '|-', $to
       or error "Unable to open pipe - $!", 1;
-      
+
     return $existingPipe;
   } else {
     open $pipe, '|-', $to
@@ -447,7 +584,7 @@ Returns:
 
 =cut
 
-  open my $pipe, "|$to" 
+  open my $pipe, '|', $to 
     or error "Unable to open pipe - $!", 1;
 
   foreach (@output) {
@@ -549,6 +686,8 @@ Returns:
   $pipeToStop ||= $pipe;
 
   close $pipeToStop if $pipeToStop;
+
+  return;
 } # StopPipe
 
 sub PageOutput (@) {
@@ -600,7 +739,7 @@ Returns:
 
 sub RedirectOutput ($$@) {
   my ($to, $mode, @output) = @_;
-  
+
 =pod
 
 =head2 RedirectOutput ($to, @ouput)
@@ -649,7 +788,7 @@ Returns:
     chomp;
     print $out "$_\n";
   } # foreach
-  
+
   return; 
 } # RedirectOutput
 
@@ -696,27 +835,27 @@ Returns:
 
   open my $file, '<', $filename
     or error "Unable to open $filename ($!)", 1;
-    
+
   if (wantarray) {
     local $/ = "\n";
 
     my @lines = <$file>;
-  
+
     close $file
       or error "Unable to close $filename ($!)", 1;
-  
+
     my @cleansed_lines;
-  
+
     foreach (@lines) {
       chomp;
       chop if /\r/;
       push @cleansed_lines, $_ if !/^#/; # Discard comment lines
     } # foreach
-  
+
     return @cleansed_lines;
   } else {
-    local $/;
-    
+    local $/ = undef;
+
     return <$file>;
   } # if
 } # ReadFile
@@ -743,7 +882,8 @@ and the values of the hash will be the counters.
 
 =item $log
 
-Logger object to log stats to (if specified)
+Logger object to log stats to (if specified). Note: if the Logger object has 
+errors or warnings then they will be automatically included in the output.
 
 =back
 
@@ -764,8 +904,13 @@ Returns:
 =cut
 
   my $msg = "$FindBin::Script Run Statistics:";
-  
-  if (scalar keys %$total) {
+
+  if ($log and ref $log eq 'Logger') {
+    $total->{errors}   = $log->{errors};
+    $total->{warnings} = $log->{warnings};
+  } # if
+
+  if (keys %$total) {
     # Display statistics (if any)
     if ($log) {
       $log->msg ($msg);
@@ -774,16 +919,16 @@ Returns:
     } # if
 
     foreach (sort keys %$total) {
-      $msg = $$total{$_} . "\t $_";
-      
+      $msg = $total->{$_} . "\t $_";
+
       if ($log) {
-        $log->msg ($$total{$_} . "\t $_");
+        $log->msg ($total->{$_} . "\t $_");
       } else {
         display $msg;
       } # if
     } # foreach
   } # if
-  
+
   return;
 } # Stats
 
@@ -854,11 +999,11 @@ L<POSIX>
 
 =head2 ClearSCM Perl Modules
 
-=for html <p><a href="/php/cvs_man.php?file=lib/Display.pm">Display</a></p>
+=for html <p><a href="/php/scm_man.php?file=lib/Display.pm">Display</a></p>
 
-=for html <p><a href="/php/cvs_man.php?file=lib/Logger.pm">Logger</a></p>
+=for html <p><a href="/php/scm_man.php?file=lib/Logger.pm">Logger</a></p>
 
-=for html <p><a href="/php/cvs_man.php?file=lib/OSDep.pm">OSDep</a></p>
+=for html <p><a href="/php/scm_man.php?file=lib/OSDep.pm">OSDep</a></p>
 
 =head1 INCOMPATABILITIES