util.pl #3

$S = "\001";
#$S = ";";

sub atq
{
  my ($s) = @_;
  $s =~ s/\@/\@\@/g;
  return "\@$s\@";
}


sub traverse
{
  local($dir, $lev, $onfile, $ondir, $onsymlink) = @_;
  
  local($dirent);
  local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
       $atime,$mtime,$ctime,$blksize,$blocks);

  local($dirhandle) = "dh$lev";

  opendir($dirhandle, $dir);

  while (($dirent = readdir($dirhandle)))
    {
      if ($dirent eq "." || $dirent eq "..") { next; }
      ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
       $atime,$mtime,$ctime,$blksize,$blocks) = lstat("$dir/$dirent");
      typsw:
        {
          -f _ && do
            { 
	      if (defined(&$onfile)) { &$onfile("$dir", "$dirent"); }
              last typsw;
            } ;
          -d _ && do
            {
	      if (defined(&$ondir)) { &$ondir("$dir", "$dirent"); }
              do traverse("$dir/$dirent", $lev+1, $onfile, $ondir, $onsymlink);
              last typsw;
            } ;
          -l "$dir/$dirent" && do
            {
	      if (defined(&$onsymlink)) { &$onsymlink("$dir", "$dirent"); }
	      if ($SYM_SPECIAL && $lev == 0)
                { do traverse("$dir/$dirent", $lev+1, $onfile, $ondir, $onsymlink); }
              last typsw;
            } ;
        }
    }
  closedir($dirhandle);
}


sub rm
{
  my($path) = @_;
  my($sts) = 0;
  if (-e $path)
    {
      print "$Myname> unlink $path\n";
      $sts = unlink $path;
      $sts = (! $sts);
      if ($sts) { print ("$Myname: *** \"unlink $path\" returned $sts\n"); }
    }
  return $sts;
}


sub s
{
  my ($cmd, $doit) = @_;
  my ($sts);

  if (! defined($doit)) { $doit = 1; }

  if (! $doit)
    {
      print "$Myname; $cmd\n";
      return;
    }

  print "$Myname> $cmd\n";

  if (($sts = system($cmd)) != 0)
    {
      my $sig = $sts & 0x0f;
      $sts = $sts >> 8;
      print ("$Myname: *** \"$cmd\" exited with signal $sig status $sts\n");
      return $sts;
    }
  return 0;
}


sub p4d_vers
{
  my ($P4D) = @_;
  my $v = `$P4D -V`;
  my ($y, $r) = ($v =~ m/\nRev. P4D\/[^\/]+\/(\d+)\.(\d+).*\//);

  if (! $v || ! $r)
    { print "$Myname: cannot recognize p4d version in:\n$v\n"; exit 1; }

  return ($y, $r);
}


1;