#HTML:Utility subroutines that I can't categories properly.<BR>

package main;

require 'timelocal.pl';

package misc;

*timelocal = *main'timelocal;#';

$tmpnam_serial = 0 if (!defined($tmpnam_serial));
$hostname_file = '/etc/HOSTNAME' if (!defined($hostname_file));# Very specific to Linux (Slackware).
$hostname_cmd = '/bin/hostname' if (!defined($hostname_cmd));
$domainname_cmd = '/bin/hostname -d' if (!defined($domainname_cmd));

sub tmpnam {
  sprintf("%s'tmpnam%d", (caller)[0], $tmpnam_serial++);
}

%unpack = (
	   STDIN, 1,
	   STDOUT, 1,
	   STDERR, 1,
	   ARGV, 1,
	   ARGVOUT, 1,
	   ENV, 1,
	   INC, 1,
	   SIG, 1,
	   '', 1,
	   );

sub pack {
  local($pack, @result) = @_;

  foreach (@result) {
    if (ref $_ eq '' && !$unpack{$_} && /^[A-Za-z]/ && !/\W/) {
      substr($_, 0, 0) = $] >= 5 ? "${pack}::" : "${pack}'";
    }
  }
  &returnn(@result);
}

sub returnn {
  wantarray ? @_ : $_[$#_];
}

sub return0 {
  wantarray ? @_ : $_[0];
}

sub quoterex {
  local(@result) = @_;

  foreach (@result) {
    s/[\\\{\}\[\]\(\)\^\$\.\?\*\+]/\\$&/g;
  }
  &returnn(@result);
}

sub makerex {
  local($n) = shift;
  local(%tab) = splice(@_, 0, $n * 2);
  local($amp, $one);

  foreach (@_) {
    s/\\([\x00-\xFF])|#.*\n[ \t]*/
      substr($&, 0, 1) eq '#' ? '' : ($1 eq '#' || $1 eq "\\") ? $one : ($tab{$1} || $&)/ge;
  }
}

sub datestr {
  local($sec,$min,$hour,$mday,$mon,$year) = localtime($_[0] ne '' ? $_[0] : time);

  sprintf("%04d/%02d/%02d %02d:%02d:%02d", 1900 + $year, $mon + 1, $mday, $hour, $min, $sec);
}

sub evalstr {
  local($i, $j, $c);

  foreach (@_) {
    for ($i = 0 ; ($j = index($_, "\\", $i)) >= 0 ;) {
      $c = substr($_, $j + 1, 1);
      if ($c eq "\\") {
	substr($_, $j, 2) = "\\";
	$i = $j + 1;
      }
      elsif ($c =~ /[tnfbae]/) {
	substr($_, $j, 2) = eval("\"\\$c\";");
	$i = $j + 1;
      }
      elsif ($c eq '0') {
	($c) = substr($_, $j) =~ /^\\0(\d*)/;
	substr($_, $j, 2 + length($c)) = pack('c', oct($c));
	$i = $j + 1;
      }
      elsif ($c eq 'x') {
	($c) = substr($_, $j) =~ /^\\x([0-9A-Za-z]{0,2})/;
	substr($_, $j, 2 + length($c)) = pack('c', hex($c));
	$i = $j + 1;
      }
      else {
	$i = $j + 2;
      }
    }
  }
}

sub escstr {
  foreach (@_) {
    s/\\/\\\\/g;
    s/\t/\\t/g;
    s/\n/\\n/g;
    s/\r/\\r/g;
    s/\f/\\f/g;
    s/\a/\\a/g;
    s/\e/\\e/g;
    s/[\x00-\x1F\x7F-\xFF]/sprintf("\\x%02X", ord($&))/eg;
  }
}

sub split {
  local($pat, $_, $n) = @_;
  local(@result);

  if ($n > 0) {
    for (; $n > 1 && /$pat/ ; --$n) {
      push(@result, $`);
      $_ = $';
    }
    if ($_ || @result) {
      push(@result, $_);
      --$n;
    }
    push(@result, (undef) x $n);
  }
  else {
    while (/$pat/) {
      push(@result, $`);
      $_ = $';
    }
    push(@result, $_) if ($_ || @result);
  }
  @result;
}

sub rec_mkdir {
  local($mode) = shift;
  local(@dir, $_);

  $mode = 0755 unless ($mode);
  foreach $dir (@_) {
    @dir = split(m%/%, $dir);
    $_ = shift(@dir);
    if ($_ ne '' && ! -d $_) {
      mkdir($_, $mode) || return undef;
    }
    while (@dir) {
      $_ = "$_/" . shift(@dir);
      if (! -d $_) {
	mkdir($_, $mode) || return undef;
      }
    }
  }
  1;
}

sub cleanup_path {
  local(@result) = @_;

  foreach (@result) {
    s%(^|/)\./%%g;
    s%//+%/%g;
    while (s%(^|/)([^/]*[^/\.][^/]*|\.{3,})/\.\./%$1%) {
    }
  }
  &returnn(@result);
}

sub unique_fname {
  local($base, $serial, $inc, $format) = @_;
  local($sec, $min, $hour, $mday, $mon, $year) = localtime(time);
  local($fn);

  $inc = -1 if ($inc eq '');
  $format = '%s' if ($format eq '');
  $base .= '.' if ($base !~ m%/$%);
  $base .= sprintf('%04d%02d%02d-%02d%02d%02d-%04X',
		   $year + ($year < 70 ? 2000 : 1900), $mon + 1, $mday, $hour, $min, $sec, $$);
  $serial += $inc while (-e ($fn = sprintf("%s$format", $base, $serial)));
  $fn;
}

sub sprintf {
  local($format, @argv) = @_;

  $format =~ s/%(%|_.\[(\d+|\d*-\d*(,[^\]]*)?)\])/&sprintf1($&)/ge;
  sprintf($format, @argv);
}

sub sprintf1 {
  local($_) = @_;

  if (/^%_(.)\[(\d+)\]$/) {
    local($format, $arg) = ("%$1", $argv[$2]);

    $arg =~ s/%/%%/g;
    sprintf($format, $arg);
  }
  elsif (/^%_s\[(\d*)-(\d*)(,[^\]]*)?\]$/) {
    local($beg, $end, $sep, $org_sep) = ($1, $2, $3, $");
    local($arg, $");

    $beg = 0 if ($beg eq '');
    $end = $#argv if ($end eq '');
    if ($sep) {
      $sep =~ s/^,//;
      $" = $sep;
    }
    else {
      $" = $org_sep;
    }
    ($arg = "@argv[$beg .. $end]") =~ s/%/%%/g;
    sprintf('%s', $arg);
  }
  else {
    $_;
  }
}

sub homedir_by_uid {
  scalar((getpwuid(@_ ? shift : $>))[7]);
}

sub homedir_by_name {
  @_ ? scalar((getpwnam(shift))[7]) : scalar((getpwuid($>))[7]);
}

sub eval_or_pack {
  local($pack, @expr) = @_;

  foreach (@expr) {
    if ($expr =~ /^\s*\{(.\n)*\}\s*$/) {
      $_ = &tmpnam;
      eval("sub $_ $expr");
    }
    else {
      $_ = &pack($pack, $_);
    }
  }
  &returnn(@expr);
}

eval <<'EOF' if ($] >= 5);

sub flat {
  local(@array);

  foreach (@_) {
    if (ref($_) eq 'ARRAY') {
      push(@array, &flat(@$_));
    }
    else {
      push(@array, $_);
    }
  }
  @array;
}

EOF

$fqdn = '';

sub hostname {
  local($_);

  if ($fqdn ne '') {
    $_ = $fqdn;
  }
  elsif (open(H, $hostname_file)) {
    $_ = <H>;
    close(H);
    s/^\s+|\s+$//g;
    unless (/\./) {
      local($temp) = &gethostbyname($_);

      $_ = $temp if ($temp ne '');
    }
    $fqdn = $_;
  }
  else {
    $_ = `$hostname_cmd`.`$domainname_cmd`;
    s/\s+//g;
    $fqdn = $_;
  }
  if (@_) {
    wantarray ? (split(/\./, $_, 2))[@_] : join('.', (split(/\./, $_, 2))[@_]);
  }
  else {
    wantarray ? split(/\./, $_) : $_;
  }
}

sub access_min {
  local($p, $top, $allow, $deny) = splice(@_, 0, 4);
  local($min, $result) = $top;

  ($p) = caller unless $p;
  grep(s/^[\x00-\xFF]+$/package $p; $&;/, $allow, $deny);
  foreach (@_) {
    $result = $allow ne '' ? eval($allow) : $top - ($deny ne '' && eval($deny));
    $min = $result if $min > $result;
    last unless $min;
  }
  $min < 0 ? 0 : $min;
}

sub access_max {
  local($p, $top, $allow, $deny) = splice(@_, 0, 4);
  local($max, $result) = 0;

  ($p) = caller unless $p;
  grep(s/^[\x00-\xFF]+$/package $p; $&;/, $allow, $deny);
  foreach (@_) {
    $result = $allow ne '' ? eval($allow) : $top - ($deny ne '' && eval($deny));
    $max = $result if $max < $result;
    last if $result >= $top;
  }
  $max > $top ? $top : $max;
}

sub make_hdoc {
  local($qb, $qe, $eod, $n);

  ($qb, $eod, $qe) = $_[0] =~ /^(\'?)(\w[\w\d]+)(\'?)$/;
  $eod .= '000000000';
  ++$eod while $_[1] =~ /(^|\n)$eod($|\n)/;
  "<<$qb$eod$qe\n$_[1]" . ($_[1] =~ /\n$/ ? "" : "\n") . "$eod\n";
}

sub time_with_unit {
  local($_, $default) = @_;
  local($n, $last, $time) = 0;

  $default = 60 * 60 * 24 if ($default eq '');
  for ($time = 0 ; s/^\d+// ;) {
    $n = $&;
    if (s/^w//i) {
      $last = $&;
      $time += $n * 60 * 60 * 24 * 7;
    }
    elsif (s/^d//i) {
      $last = $&;
      $time += $n * 60 * 60 * 24;
    }
    elsif (s/^h//i) {
      $last = $&;
      $time += $n * 60 * 60;
    }
    elsif (s/^m//i) {
      $last = $&;
      $time += $n * 60;
    }
    elsif (s/^[s\.]//i) {
      $last = $&;
      $time += $n;
    }
    else {
      return ($last =~ /w/i ? $time + $n * 60 * 60 * 24 :
	      $last =~ /d/i ? $time + $n * 60 * 60 :
	      $last =~ /h/i ? $time + $n * 60 :
	      $last =~ /m/i ? $time + $n :
	      $last =~ /[s\.]/i ? ($n =~ s/0+$//, $time + $n * (0.1) ** length($n))[1] :
	      $time + $n * $default);
    }
  }
  $time;
}

sub capitalize {
  local(@result) = @_;

  foreach (@result) {
    s/(^|[^A-Za-z])([a-z])/$1 . &upcase($2)/ge;
  }
  &returnn(@result);
}

sub upcase {
  local($_) = @_;

  tr/a-z/A-Z/;
  $_;
}

sub findex {
  local($i, $flen) = @_;

  if ($i =~ /^-/) {
    $i += $flen;
    $i = 0 if ($i < 0);
  }
  elsif ($i > $flen) {
    $i = $flen;
  }
  $i + 0;
}

sub log10_ceil {
  local($n) = @_;
  local($i) = 1;

  until ($n < 10) {
    $n = int($n / 10);
    ++$i;
  }
  $i;
}

sub mklock {
  local($fn, $tick, $nretry, $pid) = @_;
  local($pid1, $pid2);

  $pid = $$ if (!defined($pid));
  until (symlink($pid, $fn)) {
    return &return0(undef, "$fn: not a symbolic link") unless (-l $fn); 
    $pid1 = readlink($fn);
    unless (kill(0, $pid1)) {
      $pid2 = readlink($fn);
      next if ($pid1 == $pid2 && !kill(0, $pid2) && unlink($fn));
    }
    if ($tick > 0 && (!defined($nretry) || $nretry-- > 0)) {
      select(undef, undef, undef, $tick);
    }
    else {
      return &return0();
    }
  }
  &return0($fn, $pid);
}

@month = (
	  'Jan',
	  'Feb',
	  'Mar',
	  'Apr',
	  'May',
	  'Jun',
	  'Jul',
	  'Aug',
	  'Sep',
	  'Oct',
	  'Nov',
	  'Dec',
	  );

@wkday = (
	  'Sun',
	  'Mon',
	  'Tue',
	  'Wed',
	  'Thu',
	  'Fri',
	  'Sat',
	  );

sub datec {
  local($sec, $min, $hour, $day, $mon, $year, $wday) = localtime($_[0]);

  sprintf('%s %s %2d %02d:%02d:%02d %d',
	  $wkday[$wday], $month[$mon], $day, $hour, $min, $sec, $year + ($year < 70 ? 2000 : 1900));
}

sub gmdate {
  local($sec, $min, $hour, $day, $mon, $year, $wday) = gmtime($_[0]);

  sprintf('%s, %2d %s %d %02d:%02d:%02d (GMT)',
	  $wkday[$wday], $day, $month[$mon], $year + ($year < 70 ? 2000 : 1900), $hour, $min, $sec);
}

unless ($] < 5) {
  eval <<'EOF'

%filter_func = ();
$SIG{'HUP'} = "misc'load_filters";

sub load_filter {
  local($filter, $pack) = @_;
  local(*H, $func);

  if (open(H, $filter)) {
    local($expr);

    {local($/); $expr = <H>;}
    close(H);
    $pack = (caller)[0] if ($pack eq '');
    $func = eval("package $pack; sub {\n$expr\n}");
    return (undef, $@) if ($@ ne '');
    $filter_func{$filter} = $func;
    ($func);
  }
  else {
    (undef, "open(H, \"$filter\"): $!");
  }
}

sub load_filters {
  local($sig, $error);

  foreach (keys(%filter_func)) {
    &load_filter($_);
  }
  $SIG{$sig} = "misc'load_filters";
}

EOF
}

sub elog {
  local($handle) = $_[1];

  $handle = 'STDERR' if (!defined($handle));
  foreach (split(/\n/, $_[0])) {
    print $handle $_, "\n";
  }
}

1;