#!/usr/bin/perl
#   Misc. PERL utility subroutines.
#
#   Include the following command in your Perl script before using the
#   subroutines and functions:
#      require "bj-lib.pl";
#
#------------------------------------------------------------------------------
sub ReadPairs {
# Create an array of name/value pairs from a file.
# Name and value are separated by "=".
# Pairs are separated by line feed. 
#
# Usage: ReadPair(filename, arrayname);

  local ($filename, *pp) = @_;
  local ($i, $key, $val, $line);

  # Read in text
    $pp="";
    $i=0;
    open (READPAIR, "<$filename");
    foreach $line (<READPAIR>) {
       $pp .= $line;
       $i++;
       chop $line;
       $pp[$i]=$line;

       # Split into key and value.
       ($key, $val) = split(/=/,$pp[$i],2);
       $key=lower(alltrim($key));
       $val=alltrim($val);
       $pp{$key} = $val;
    }    
    close (READPAIR);
    return scalar(@pp);
}

#------------------------------------------------------------------------------
sub binseek {
# Binary search for key string in sorted file, case-insensitive.
# Usage:  open(HANDLE, file_name); ...;
#         $irec = binseek($key_value, $key_position, $key_length,
#                         $len_rec, $nstart, $nlast, HANDLE);
#         ...; close(HANDLE);
#
# where:
#    $key_value    - Key value to search for.
#    $key_position - Offset in record to beginning of key.
#    $key_length   - Length of key string.
#    $len_rec      - Length of record (excluding line feed byte).
#    $nstart       - Starting record number for search.
#    $nlast        - Last record number for search.
#    HANDLE        - File handle.

local($key_value, $key_position, $key_length,
      $len_rec, $nstart, $nlast, $handle) = @_;

local($value, $left, $right, $ipt, $key, $length);
$value=upper($key_value);
$value=rpad($value, $key_length);
$left=$nstart;
$right=$nlast;

while ($left < $right + 1) {
   $ipt=int(($left + $right) / 2);
   seek ($handle, ($ipt-1)*($len_rec+1) + $key_position, 0);
   read ($handle, $key, $key_length);
   $key = upper($key);
   if ($key lt $value) {
      $left=$ipt + 1;
   } elsif ($key gt $value) {
      $right = $ipt - 1;
   } else {
      $left=$right+2;
   }
}

# Return negative number if exact match not found.
# This is the first record with $key greater than $key_value.
#
if ($key lt $value) {
   $ipt=-($ipt+1);
} elsif ($key gt $value) {
   $ipt=-$ipt;
}
$ipt;
}

#------------------------------------------------------------------------------
sub wiper {
# wiper - Delete temporary files from a directory.
#
# Usage:  wiper("directory", 'mask', age);
# where:  Directory is the name of a directory where the temporary files are
#              located.  Defaults to ".".
#         Mask is a substitution mask for file names containing PIDs.
#              Mask returns the PID values.
#         Age is the minimum age (in minutes) at which a file will be deleted.
#
# Returns: Number of files deleted.
#
# Example: wiper("tmp", '^x(\d+)\.tmp$', 30);
#    The directory is tmp. The mask returns the PID from file names of the
#    form, "xN.tmp", where N is the PID number.  N may have leading zeros.
#    Only files over 30 minutes old will be deleted.
#
#    In the file name, the PID prefix is "x", the PID is represented by
#    "(\d+)", and the suffix is "\.tmp".  The "\." represents the dot, ".".
#    See Learning Perl, p. 24-29.
#
# Files containing the PID of an active process and files not matching the
# mask pattern will be left alone.

local($directory, $mask, $age) = @_;
local($pids, $pid);
local(@files, $deleted);

if (! $directory) {
   $directory = ".";
}

# Get list of files in directory.
if (opendir(DIR, $directory)) {
   @files = readdir(DIR);
   closedir(DIR);
}

# Get list of active processes.
open (PS, "ps -a|");
$pids = ":";
while (($pid = <PS>) =~ s/^\s*(\S+)\s.*\n/$1/) {
   $pids = "$pids$pid:";
}
close (PS);

# Loop over file names.
$deleted = 0;
foreach $i (0 .. $#files) {
   ($pid = $files[$i]) =~ s/$mask/$1/;             # Get PID from file name.
   $pid =~  s/^0+(\d+)$/$1/;                       # Remove leading zeros.
   # Delete file if PID was found in file name and the process is not active.
   if (index($pids, ":$pid:") < 0 &&
       $pid ne $files[$i] &&
       $age <= ((-M "$directory/$files[$i]")*1440.)) {
      $deleted += unlink("$directory/$files[$i]");
   }
}
$deleted;        # Number of files deleted.
}

#------------------------------------------------------------------------------
sub GetText{
# Copy the contents of a text file into an array.
# Beware if the file is very big.

local ($filename) = @_;

local ($FileText) = "";

open (TEXTFILE, "<$filename");
foreach $line (<TEXTFILE>) {
   $FileText .= $line;
}
close (TEXTFILE);

$FileText;
}

#------------------------------------------------------------------------------
sub iif {
# Instream if.
# Usage:  $y = iif($test, $if_true, $if_false)

local($test, $if_true, $if_false) = @_;
if ($test) {
   $if_true;
} else {
   $if_false;
}
}

#------------------------------------------------------------------------------
sub gprint {
local($x, $l) = @_;
   # Return a floating point number ($x) with ($l) significant digits
   # with an improved "g" format.

   local ($m, $n, $y, $z);
   $m = $l+4;
   $y = sprintf("%.$m"."g", sprintf("%.$l"."g", $x));
   $z = $y;
   $z =~ s/(^[+-]?)(\d+)\.?(\d*)(.*)$/$2$3/;
   $n = "0" x ($l-length($z+0));
   $z = $y;
   $z =~ s/^([+-]?)(\d+)$/$1$2./;
   $z =~ s/^([+-]?)(\d+)(\.?)(\d*)(.*)$/$1$2$3$4$n$5/;
   $z =~ s/^(.*)e([+-])\d(\d\d)$/$1E$2$3/;
   return $z;
}

#------------------------------------------------------------------------------
sub rtrim {
# Remove trailing blanks from a string.
# Usage:  $y = rtrim($mystring)

local($string) = @_;
while (substr($string,-1,1) eq " ") {chop($string);}
$string;
}

#------------------------------------------------------------------------------
sub truncstr {
# Truncate a string.
# Usage:  $y = truncate($mystring, $length)

local($string, $length) = @_;
if (length($string) > $length)
   {$string = substr($string,0,$length);}
$string;
}

#------------------------------------------------------------------------------
sub ltrim {
# Remove leading blanks from a string.
# Usage:  $y = ltrim($mystring)

local($string) = @_;
while (substr($string,0,1) eq " ") {$string=substr($string,1);}
$string;
}

#------------------------------------------------------------------------------
sub alltrim {
# Remove leading and trailing blanks from a string.
# Usage:  $y = alltrim($mystring)

local($string) = @_;
while (substr($string,0,1) eq " ") {$string=substr($string,1);}
while (substr($string,-1,1) eq " ") {chop($string)};
$string;
}

#------------------------------------------------------------------------------
sub rjust {
# Right justify text in a string.
# Usage:  $y = ljust($mystring)

local($string) = @_;
while (substr($string,-1,1) eq " ") {chop($string); $string = " " . $string;}
$string;
}

#------------------------------------------------------------------------------
sub ljust {
# Left justify text in a string.
# Usage:  $y = ljust($mystring)

local($string) = @_;
while (substr($string,0,1) eq " ") {$string=substr($string,1) . " ";}
$string;
}

#------------------------------------------------------------------------------
sub center {
# Center text in a string.
# Usage:  $y = center($mystring)

local($string) = @_;
local($length) = length($string);
local($left, $right);
while (substr($string,0,1) eq " ") {$string=substr($string,1);}
while (substr($string,-1,1) eq " ") {chop($string);}
$left=" " x int(($length-length($string))/2);
$right=" " x ($length-length($string . $left));
$string=$left . $string . $right;
$string;
}

#------------------------------------------------------------------------------
sub center2 {
# Center text in a string of specified length (truncate to fit).
# Usage:  $y = center($mystring, $newlength)

local($string, $length) = @_;
local($left, $right);
while (substr($string,0,1) eq " ") {$string=substr($string,1);}
while (substr($string,-1,1) eq " ") {chop($string);};
if ($length < length($string)) {$string=substr($string,0,$length);}
$left=" " x int(($length-length($string))/2);
$right=" " x ($length-length($string . $left));
$string=$left . $string . $right;
$string;
}

#------------------------------------------------------------------------------
sub rpad {
# Pad string with blanks to specified length (truncate to fit).
# Usage:  $y = rpad($mystring, $newlength)

local($string, $length) = @_;
if ($length < length($string)) {$string=substr($string,0,$length);}
while (substr($string,-1,1) eq " ") {chop($string);}
while (length($string) < $length) {$string = $string . " ";}
$string;
}

#------------------------------------------------------------------------------
sub upper {
# Convert a string to upper case.
# Usage: $y = upper($mystring)

local ($string) = @_;
$string =~ tr/a-z/A-Z/;
$string;
}

#------------------------------------------------------------------------------
sub lower {
# Convert a string to lower case.
# Usage: $y = lower($mystring)

local ($string) = @_;
$string =~ tr/A-Z/a-z/;
$string;
}

#------------------------------------------------------------------------------
1;