util.pl #16

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

# $Id: //guest/richard_geiger/utils/cvs2p4/lib/util.pl#16 $

#   @ # % * escapes...
#
sub p4_esc
{
  my ($path, $synced) = (@_);

  # An attempt to optimize... since most paths don't get touched:
  #
  if ($path !~ /[\%\@\#\*\r]|\.\.\./) { return $path; }

  # Files added with these get _synced_ with the real character used in the
  # workspace... apparently!:
  #
  if (! $synced)
    {
      $path =~ s/%/%25/g;

      $path =~ s/^\@/\001/;
      $path =~ s/\@$/\001/;
      $path =~ s/\@\@/%40/g;
      $path =~ s/^\001/\@/;
      $path =~ s/\001$/\@/;

      $path =~ s/#/%23/g;
      $path =~ s/\*/%2a/g;
    }

  $path =~ s/\r/%0d/g;

  # CVS allows "..." in pathnames - Perforce does not.
  #
  $path =~ s/\.\.\./,,,/g;

  return $path;
}



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
            {
              # $Depotmap may be used to skip modules under CVSROOT...
              #
              if (! ($lev == 0 && $Depotmap{$dirent} eq "IGNORE"))
                {
                  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);
}


#  Load the branch and tag exclusion lists, if any:
#
sub load_excludes
{
  my $exc_path;

  if (-e "$Convdir/exclude_tags")
    { $exc_path = "$Convdir/exclude_tags"; }
  elsif (-e "$Convdir/../exclude_tags")
    { $exc_path = "$Convdir/../exclude_tags"; }

  my @modules = ();

  if ($exc_path)
    {
      if (! open(EXCLTAGS, "<$exc_path"))
        {
          printf STDERR "open(\"$exc_path\" failed: $!\n";
          exit 1;
        }

      $ntags = 0;
      while (<EXCLTAGS>)
        {
          chomp $_;

          if (/^\s*#/ || /^\s*$/) { next; }
          $_ =~ s/^\s*//;
          $_ =~ s/\s*#.*$//;

          if (/^:(.*)/)
            {
              @modules = split(/[\s?,\s?]/, $1);
              next;
            }

          my $tag = $_;

          foreach my $module (@modules)
            {
              if (! defined($Exclude_tags{$module})) { $Exclude_tags{$module} = {}; }
              ${$Exclude_tags{$module}}{$tag} = 1;          
              $ntags++;
            }
        }
      close EXCLTAGS;
      print "$Myname: loaded $ntags tag exclusions from $exc_path.\n";
    }

  $exc_path = "";
  @modules = ();

  if (-e "$Convdir/exclude_branches")
    { $exc_path = "$Convdir/exclude_branches"; }
  elsif (-e "$Convdir/../exclude_branches")
    { $exc_path = "$Convdir/../exclude_branches"; }

  if ($exc_path)
    {
      if (! open(EXCLTAGS, "<$exc_path"))
        {
          printf STDERR "open(\"$exc_path\" failed: $!\n";
          exit 1;
        }

      $ntags = 0;
      while (<EXCLTAGS>)
        {
          chomp $_;
          if (/^\s*#/ || /^\s*$/) { next; }
          $_ =~ s/^\s*//;
          $_ =~ s/\s*#.*$//;

          if (/^:(.*)/)
            {
              @modules = split(/[\s?,\s?]/, $1);
              next;
            }

          my $tag = $_;

          foreach my $module (@modules)
            {
              if (! defined($Exclude_branches{$module})) { $Exclude_branches{$module} = {}; }
              ${$Exclude_branches{$module}}{$tag} = 1;          
              $ntags++;
            }
        }
      close EXCLTAGS;
      print "$Myname: loaded $ntags branch tag exclusions from $exc_path.\n";
    }
}


#  This is how we pick up the &brmap function from
#  $Convdir/brmap.pl (if present).
#
sub load_brmap
{
  if (-f "$Convdir/brmap.pl")
    {
      if (! open(BRMAP, "<$Convdir/brmap.pl"))
        {
          print "$Myname: open \"<$Convdir/brmap.pl\" failed: $!.\n";
          exit 1;
        }
  
      my $brmap_pl;
      { local $/; $brmap_pl = <BRMAP>; }
  
      close BRMAP;
  
      my $evret;
      eval $brmap_pl;
      if ($@)
        {
          print "eval $Convdir/brmap.pl failed: $@\n";
          exit 1;
        }
      print "eval'ed $Convdir/brmap.pl ok.\n";
    }
}

#  This is (as yet, anyway) an undocumented feature
#  aimed at allowing more flexible mapping between
#  CVS (pre-conversion) and Perforce (post-conversion)
#  pathnames. Note that this is sensitive to the position
#  of your branch-level directories!
#
sub Pathhacks
{
  my ($path) = @_;

  if ($path =~ /^@\/\/([^\/]+)\/[^\/]+\/([^\/]+)\//)
    { if ($1 eq $2)  { $path =~ s/^(@\/\/[^\/]+\/[^\/]+\/)[^\/]+\//$1/; } }

  if ($path =~ /^@\/\/user\/([^\/]+)\/([^\/]+)\/(.*)$/)
    { $path = "\@//user/$2/$1/$3"; }

  return $path;
}

1;