X-Git-Url: https://defaria.com/gitweb/?a=blobdiff_plain;ds=inline;f=lib%2FUtils.pm;h=ea189a12898537405dc531b90530799b8b2ceb29;hb=065171a4982e361ef528bbee88bc160ce1d69aa1;hp=acebce5074f634f4608c90ddd4b8e64fdc60083c;hpb=f4cba91d9cce314c632afe2e05987670c0d1813e;p=clearscm.git diff --git a/lib/Utils.pm b/lib/Utils.pm index acebce5..ea189a1 100644 --- a/lib/Utils.pm +++ b/lib/Utils.pm @@ -68,16 +68,21 @@ use Term::ReadKey; use OSDep; use Display; +our $pipe; + our @EXPORT = qw ( + CheckParms EnterDaemonMode Execute GetChildren GetPassword InArray + LoadAvg PageOutput PipeOutput PipeOutputArray ReadFile + RequiredFields RedirectOutput StartPipe Stats @@ -85,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 @@ -141,7 +160,7 @@ Returns: $errorlog ||= $NULL; my $file; - + # Redirect STDIN to $NULL open STDIN, '<', $NULL or error "Can't read $NULL ($!)", 1; @@ -155,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"; @@ -168,7 +187,7 @@ Returns: # Now the parent exits exit if $pid; - + # Write pidfile if specified if ($pidfile) { $pidfile = File::Spec->rel2abs ($pidfile); @@ -177,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 @@ -231,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 @@ -296,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\)/; @@ -304,12 +317,12 @@ Returns: if (/\((\d+)\)/) { push @children, $1; } # if - } # foreach + } # for return @children; } # GetChildren -sub GetPassword (;$) { +sub GetPassword(;$) { my ($prompt) = @_; =pod @@ -346,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)/) { @@ -370,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 @@ -423,16 +444,67 @@ Returns: =cut - foreach (@array) { + for (@array) { return $TRUE if $item eq $_; - } # foreach + } # for return $FALSE; } # InArray -our $pipe; +sub LoadAvg () { + +=pod + +=head2 LoadAvg () + +Return an array of the 1, 5, and 15 minute load averages. + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=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+ +=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; -sub StartPipe ($;$) { + if (wantarray) { + return @loadAvgs; + } else { + return $loadAvgs[0]; # This is the 1 minute average + } +} # LoadAvg + +sub StartPipe($;$) { my ($to, $existingPipe) = @_; =pod @@ -475,10 +547,10 @@ Returns: if ($existingPipe) { close $existingPipe; - + open $existingPipe, '|-', $to or error "Unable to open pipe - $!", 1; - + return $existingPipe; } else { open $pipe, '|-', $to @@ -488,7 +560,7 @@ Returns: } # if } # StartPipe -sub PipeOutputArray ($@) { +sub PipeOutputArray($@) { my ($to, @output) = @_; =pod @@ -506,7 +578,7 @@ Parameters: =item $to String representing the other end of the pipe to pipe @output to - + =item @output Output to pipe @@ -532,16 +604,16 @@ Returns: 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 @@ -591,7 +663,7 @@ Returns: return; } # PipeOutput -sub StopPipe (;$) { +sub StopPipe(;$) { my ($pipeToStop) = @_; =pod @@ -631,13 +703,13 @@ Returns: $pipeToStop ||= $pipe; close $pipeToStop if $pipeToStop; - + return; } # StopPipe -sub PageOutput (@) { +sub PageOutput(@) { my (@output) = @_; - + =pod =head2 PageOutput (@ouput) @@ -676,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) @@ -729,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 @@ -780,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 @@ -849,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) { @@ -863,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 @@ -914,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