X-Git-Url: https://defaria.com/gitweb/?a=blobdiff_plain;f=lib%2FUtils.pm;h=ea189a12898537405dc531b90530799b8b2ceb29;hb=7ddf095f187ca60d9a70fb83b2bc3c2b6d91f088;hp=9666d81d3e7ef3d1c3e28dd4a8d67e3bd1afd357;hpb=14a28ba376f8fd4fc69453813a46c9f48419a76f;p=clearscm.git

diff --git a/lib/Utils.pm b/lib/Utils.pm
index 9666d81..ea189a1 100644
--- a/lib/Utils.pm
+++ b/lib/Utils.pm
@@ -68,7 +68,10 @@ use Term::ReadKey;
 use OSDep;
 use Display;
 
+our $pipe;
+
 our @EXPORT = qw (
+  CheckParms
   EnterDaemonMode
   Execute
   GetChildren
@@ -79,6 +82,7 @@ our @EXPORT = qw (
   PipeOutput
   PipeOutputArray
   ReadFile
+  RequiredFields
   RedirectOutput
   StartPipe
   Stats
@@ -86,16 +90,30 @@ our @EXPORT = qw (
   Usage
 );
 
-sub _restoreTerm () {
+sub _restoreTerm() {
   # In case the user hits Ctrl-C
   print "\nControl-C\n";
-  
+
   ReadMode 'normal';
-  
+
   exit;
 } # _restoreTerm
 
-sub EnterDaemonMode (;$$$) {
+sub CheckParms($$) {
+  my ($requiredFields, $rec) = @_;
+
+  my $msg = RequiredFields($requiredFields, $rec);
+
+  my $function   = (caller(1))[3];
+  my $calledFrom = (caller(2))[3];
+  my $lineNbr    = (caller(2))[2];
+
+  croak "Internal error: $function called from $calledFrom:$lineNbr\n\nThe field $msg" if $msg;
+
+  return;
+} # CheckParms
+
+sub EnterDaemonMode(;$$$) {
   my ($logfile, $errorlog, $pidfile) = @_;
 
 =pod
@@ -142,7 +160,7 @@ Returns:
   $errorlog ||= $NULL;
 
   my $file;
-  
+
   # Redirect STDIN to $NULL
   open STDIN, '<', $NULL
     or error "Can't read $NULL ($!)", 1;
@@ -156,7 +174,7 @@ Returns:
     or error "Can't write to $errorlog ($!)", 1;
 
   # Change the current directory to /
-  my $ROOT = $ARCH eq "windows" ? "C:\\" : "/";
+  my $ROOT = $ARCHITECTURE eq "windows" ? "C:\\" : "/";
   chdir $ROOT
     or error "Can't chdir to $ROOT ($!), 1";
 
@@ -169,7 +187,7 @@ Returns:
 
   # Now the parent exits
   exit if $pid;
-  
+
   # Write pidfile if specified
   if ($pidfile) {
     $pidfile =  File::Spec->rel2abs ($pidfile); 
@@ -178,18 +196,18 @@ Returns:
       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
 
-sub Execute ($) {
+sub Execute($) {
   my ($cmd) = @_;
 
 =pod
@@ -232,23 +250,17 @@ STDOUT then do so in the $command passed in.
 
 =cut
 
-  # Save $SIG{CHLD} so we can set it to 'DEFAULT' and then restore it later.
-  # Helps when you are doing process handling.
-  my $sigchld = $SIG{CHLD};
-
   local $SIG{CHLD} = 'DEFAULT';
 
   my @output = `$cmd`;
   my $status = $?;
-  
-  local $SIG{CHLD} = $sigchld;
 
   chomp @output;
 
-  return ($status, @output);
+  return wantarray ? ($status, @output) : $status;
 } # Execute
 
-sub GetChildren (;$) {
+sub GetChildren(;$) {
   my ($pid) = @_;
 
 =pod
@@ -297,7 +309,7 @@ Returns:
 
   chomp @output;
 
-  foreach (@output) {
+  for (@output) {
     # Skip the pstree process and the parent process - we want only
     # our children.
     next if /pstree/ or /\($pid\)/;
@@ -305,12 +317,12 @@ Returns:
     if (/\((\d+)\)/) {
       push @children, $1;
     } # if
-  } # foreach
+  } # for
 
   return @children;
 } # GetChildren
 
-sub GetPassword (;$) {
+sub GetPassword(;$) {
   my ($prompt) = @_;
 
 =pod
@@ -347,22 +359,21 @@ Returns:
 
 =cut  
 
-  
   $prompt ||= 'Password';
-  
-  my $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)/) {
@@ -371,19 +382,28 @@ Returns:
        last;
     } # if
 
-    print '*';
-    
-    $password .= $key;
+    # Handle backspaces
+    if ($key eq chr(127)) {
+      unless ($password eq '') {
+        chop $password;
+
+        print "\b \b";
+      } # unless
+    } else {
+      print '*';
+
+      $password .= $key;
+    } # if
   } # while
-  
+
   ReadMode 'restore'; # Reset tty mode before exiting.
 
   $SIG{INT} = 'DEFAULT';
-  
+
   return $password;
 } # GetPassword
 
-sub InArray ($@) {
+sub InArray($@) {
   my ($item, @array) = @_;
 
 =pod
@@ -424,9 +444,9 @@ Returns:
 
 =cut
 
-  foreach (@array) {
+  for (@array) {
     return $TRUE if $item eq $_;
-  } # foreach
+  } # for
 
   return $FALSE;
 } # InArray
@@ -464,20 +484,19 @@ In a scalar context just the 1 minute load average.
 
 =for html </blockquote>
 
-=cut  
-
+=cut
   # TODO: Make it work on Windows...
   return if $^O =~ /win/i;
-  
-  open my $loadAvg, '/proc/loadavg'
+
+  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 {
@@ -485,9 +504,7 @@ In a scalar context just the 1 minute load average.
   }
 } # LoadAvg
 
-our $pipe;
-
-sub StartPipe ($;$) {
+sub StartPipe($;$) {
   my ($to, $existingPipe) = @_;
 
 =pod
@@ -530,10 +547,10 @@ Returns:
 
   if ($existingPipe) {
     close $existingPipe;
-    
+
     open $existingPipe, '|-', $to
       or error "Unable to open pipe - $!", 1;
-      
+
     return $existingPipe;
   } else {
     open $pipe, '|-', $to
@@ -543,7 +560,7 @@ Returns:
   } # if
 } # StartPipe
 
-sub PipeOutputArray ($@) {
+sub PipeOutputArray($@) {
   my ($to, @output) = @_;
 
 =pod
@@ -561,7 +578,7 @@ Parameters:
 =item $to
 
 String representing the other end of the pipe to pipe @output to
- 
+
 =item @output
 
 Output to pipe
@@ -584,19 +601,19 @@ Returns:
 
 =cut
 
-  open my $pipe, '|', $to 
+  open my $pipe, '|-', $to 
     or error "Unable to open pipe - $!", 1;
 
-  foreach (@output) {
+  for (@output) {
     chomp;
 
     print $pipe "$_\n";
-  } # foreach
+  } # for
 
   return close $pipe;
 } # PipeOutputArray
 
-sub PipeOutput ($;$) {
+sub PipeOutput($;$) {
   my ($line, $topipe) = @_;
 
 =pod
@@ -646,7 +663,7 @@ Returns:
   return;
 } # PipeOutput
 
-sub StopPipe (;$) {
+sub StopPipe(;$) {
   my ($pipeToStop) = @_;
 
 =pod
@@ -686,13 +703,13 @@ Returns:
   $pipeToStop ||= $pipe;
 
   close $pipeToStop if $pipeToStop;
-  
+
   return;
 } # StopPipe
 
-sub PageOutput (@) {
+sub PageOutput(@) {
   my (@output) = @_;
-  
+
 =pod
 
 =head2 PageOutput (@ouput)
@@ -731,15 +748,15 @@ Returns:
     PipeOutputArray $ENV{PAGER}, @output;
   } else {
     print "$_\n"
-      foreach (@output);
+      for (@output);
   } # if
-  
+
   return;
 } # PageOutput
 
-sub RedirectOutput ($$@) {
+sub RedirectOutput($$@) {
   my ($to, $mode, @output) = @_;
-  
+
 =pod
 
 =head2 RedirectOutput ($to, @ouput)
@@ -784,15 +801,17 @@ Returns:
   open my $out, $mode, $to
     or croak "Unable to open $to for writing - $!";
 
-  foreach (@output) {
+  for (@output) {
     chomp;
     print $out "$_\n";
-  } # foreach
+  } # for
+
+  close $out;
   
-  return; 
+  return;
 } # RedirectOutput
 
-sub ReadFile ($) {
+sub ReadFile($) {
   my ($filename) = @_;
 
 =pod
@@ -835,32 +854,32 @@ 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) {
+
+    for (@lines) {
       chomp;
       chop if /\r/;
       push @cleansed_lines, $_ if !/^#/; # Discard comment lines
-    } # foreach
-  
+    } # for
+
     return @cleansed_lines;
   } else {
     local $/ = undef;
-    
+
     return <$file>;
   } # if
 } # ReadFile
 
-sub Stats ($;$) {
+sub Stats($;$) {
   my ($total, $log) = @_;
 
 =pod
@@ -904,12 +923,12 @@ Returns:
 =cut
 
   my $msg = "$FindBin::Script Run Statistics:";
-  
+
   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) {
@@ -918,21 +937,21 @@ Returns:
       display $msg; 
     } # if
 
-    foreach (sort keys %$total) {
+    for (sort keys %$total) {
       $msg = $total->{$_} . "\t $_";
-      
+
       if ($log) {
         $log->msg ($total->{$_} . "\t $_");
       } else {
         display $msg;
       } # if
-    } # foreach
+    } # for
   } # if
-  
+
   return;
 } # Stats
 
-sub Usage (;$) {
+sub Usage(;$) {
   my ($msg) = @_;
 
 =pod
@@ -969,14 +988,74 @@ Returns:
 
 =cut
 
-  display $msg
-    if $msg;
+  display $msg if $msg;
 
   system "perldoc $0";
 
   exit 1;
 } # Usage
 
+sub RequiredFields($$) {
+
+=pod
+
+=head2 RequiredFields($total, $log)
+
+Check if a list of fields are contained in a hash
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item $fields
+
+Array reference to a list of field names that are required
+
+=item $rec
+
+Hash reference whose key values we are checking
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item Message
+
+Returns either an empty string or a string naming the first missing required
+field
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+  my ($fields, $rec) = @_;
+
+  for my $fieldname (@$fields) {
+    my $found = 0;
+
+    for (keys %$rec) {
+      if ($fieldname eq $_) {
+        $found = 1;
+        last;
+      } # if
+    } # for
+
+    return "$fieldname is required" unless $found;
+  } # for
+
+  return;
+} # RequiredFields
+
 END {
   StopPipe;
 } # END