X-Git-Url: https://defaria.com/gitweb/?a=blobdiff_plain;ds=inline;f=lib%2FUtils.pm;h=ea189a12898537405dc531b90530799b8b2ceb29;hb=a9acda90df2ba4a4777fe263005a5d45ffd869e0;hp=f52fe4be1acc442d817d541361c0d99767a5f9fd;hpb=1140ca8d56832ae529db0f353112ac192cdf9432;p=clearscm.git diff --git a/lib/Utils.pm b/lib/Utils.pm index f52fe4b..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,7 +90,7 @@ our @EXPORT = qw ( Usage ); -sub _restoreTerm () { +sub _restoreTerm() { # In case the user hits Ctrl-C print "\nControl-C\n"; @@ -95,7 +99,21 @@ sub _restoreTerm () { 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 @@ -189,7 +207,7 @@ Returns: return; } # EnterDaemonMode -sub Execute ($) { +sub Execute($) { my ($cmd) = @_; =pod @@ -239,10 +257,10 @@ STDOUT then do so in the $command passed in. chomp @output; - return ($status, @output); + return wantarray ? ($status, @output) : $status; } # Execute -sub GetChildren (;$) { +sub GetChildren(;$) { my ($pid) = @_; =pod @@ -291,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\)/; @@ -299,12 +317,12 @@ Returns: if (/\((\d+)\)/) { push @children, $1; } # if - } # foreach + } # for return @children; } # GetChildren -sub GetPassword (;$) { +sub GetPassword(;$) { my ($prompt) = @_; =pod @@ -341,10 +359,9 @@ Returns: =cut - $prompt ||= 'Password'; - my $password; + my $password = ''; local $| = 1; @@ -357,7 +374,7 @@ Returns: while () { my $key; - while (not defined ($key = ReadKey -1)) { } + while (not defined ($key = ReadKey -1)) { } if ($key =~ /(\r|\n)/) { print "\n"; @@ -365,9 +382,18 @@ Returns: last; } # if - print '*'; + # Handle backspaces + if ($key eq chr(127)) { + unless ($password eq '') { + chop $password; - $password .= $key; + print "\b \b"; + } # unless + } else { + print '*'; + + $password .= $key; + } # if } # while ReadMode 'restore'; # Reset tty mode before exiting. @@ -377,7 +403,7 @@ Returns: return $password; } # GetPassword -sub InArray ($@) { +sub InArray($@) { my ($item, @array) = @_; =pod @@ -418,9 +444,9 @@ Returns: =cut - foreach (@array) { + for (@array) { return $TRUE if $item eq $_; - } # foreach + } # for return $FALSE; } # InArray @@ -458,12 +484,11 @@ In a scalar context just the 1 minute load average. =for html -=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>; @@ -479,9 +504,7 @@ In a scalar context just the 1 minute load average. } } # LoadAvg -our $pipe; - -sub StartPipe ($;$) { +sub StartPipe($;$) { my ($to, $existingPipe) = @_; =pod @@ -537,7 +560,7 @@ Returns: } # if } # StartPipe -sub PipeOutputArray ($@) { +sub PipeOutputArray($@) { my ($to, @output) = @_; =pod @@ -555,7 +578,7 @@ Parameters: =item $to String representing the other end of the pipe to pipe @output to - + =item @output Output to pipe @@ -578,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 @@ -640,7 +663,7 @@ Returns: return; } # PipeOutput -sub StopPipe (;$) { +sub StopPipe(;$) { my ($pipeToStop) = @_; =pod @@ -684,9 +707,9 @@ Returns: return; } # StopPipe -sub PageOutput (@) { +sub PageOutput(@) { my (@output) = @_; - + =pod =head2 PageOutput (@ouput) @@ -725,13 +748,13 @@ Returns: PipeOutputArray $ENV{PAGER}, @output; } else { print "$_\n" - foreach (@output); + for (@output); } # if - + return; } # PageOutput -sub RedirectOutput ($$@) { +sub RedirectOutput($$@) { my ($to, $mode, @output) = @_; =pod @@ -778,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 - return; + close $out; + + return; } # RedirectOutput -sub ReadFile ($) { +sub ReadFile($) { my ($filename) = @_; =pod @@ -840,11 +865,11 @@ Returns: my @cleansed_lines; - foreach (@lines) { + for (@lines) { chomp; chop if /\r/; push @cleansed_lines, $_ if !/^#/; # Discard comment lines - } # foreach + } # for return @cleansed_lines; } else { @@ -854,7 +879,7 @@ Returns: } # if } # ReadFile -sub Stats ($;$) { +sub Stats($;$) { my ($total, $log) = @_; =pod @@ -912,7 +937,7 @@ Returns: display $msg; } # if - foreach (sort keys %$total) { + for (sort keys %$total) { $msg = $total->{$_} . "\t $_"; if ($log) { @@ -920,13 +945,13 @@ Returns: } else { display $msg; } # if - } # foreach + } # for } # if return; } # Stats -sub Usage (;$) { +sub Usage(;$) { my ($msg) = @_; =pod @@ -963,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
+ +=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+ +Returns: + +=for html
+ +=over + +=item Message + +Returns either an empty string or a string naming the first missing required +field + +=back + +=for html+ +=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