X-Git-Url: https://defaria.com/gitweb/?a=blobdiff_plain;ds=inline;f=lib%2FUtils.pm;h=ea189a12898537405dc531b90530799b8b2ceb29;hb=065171a4982e361ef528bbee88bc160ce1d69aa1;hp=78af1712658f5e5ef9a49634407f424f89337ff1;hpb=a5e947bf363fa107c5f7de50e6334ddcec415eb0;p=clearscm.git diff --git a/lib/Utils.pm b/lib/Utils.pm index 78af171..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 @@ -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"; @@ -189,7 +207,7 @@ Returns: 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,10 +359,9 @@ Returns: =cut - $prompt ||= 'Password'; - my $password; + my $password = ''; local $| = 1; @@ -371,9 +382,18 @@ Returns: last; } # if - print '*'; + # Handle backspaces + if ($key eq chr(127)) { + unless ($password eq '') { + chop $password; + + print "\b \b"; + } # unless + } else { + print '*'; - $password .= $key; + $password .= $key; + } # if } # while ReadMode 'restore'; # Reset tty mode before exiting. @@ -383,7 +403,7 @@ Returns: 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,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>; @@ -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 @@ -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 @@ -690,9 +707,9 @@ Returns: return; } # StopPipe -sub PageOutput (@) { +sub PageOutput(@) { my (@output) = @_; - + =pod =head2 PageOutput (@ouput) @@ -731,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 @@ -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 - return; + close $out; + + return; } # RedirectOutput -sub ReadFile ($) { +sub ReadFile($) { my ($filename) = @_; =pod @@ -846,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 { @@ -860,7 +879,7 @@ Returns: } # if } # ReadFile -sub Stats ($;$) { +sub Stats($;$) { my ($total, $log) = @_; =pod @@ -918,7 +937,7 @@ Returns: display $msg; } # if - foreach (sort keys %$total) { + for (sort keys %$total) { $msg = $total->{$_} . "\t $_"; if ($log) { @@ -926,13 +945,13 @@ Returns: } 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
+ +=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