dolabels #45

eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
  & eval 'exec perl -S $0 $argv:q'
  if 0;
#  THE PRECEEDING STUFF EXECS perl via $PATH
# -*-Fundamental-*-

#  $Id: //guest/richard_geiger/utils/cvs2p4/bin/genmetadata#14 $
#
#  Richard Geiger
#

require 5.000;

#use bytes;

sub dirname
{
  local($dir) = @_;
  $dir =~ s%^$%.%; $dir = "$dir/";
  if ($dir =~ m%^/[^/]*//*$%) { return "/"; }
  if ($dir =~ m%^.*[^/]//*[^/][^/]*//*$%)
  { $dir =~ s%^(.*[^/])//*[^/][^/]*//*$%$1%; { return $dir; } }
  return ".";
}

use Carp; # ...or flounder. (This will fail unless 'perl' is a perl5!)
$| = 1;

($Myname = $0) =~ s%^.*/%%;
$Mydir = &dirname($0);
$Here = `/bin/pwd`; chop $Here;
if ($Mydir ne ".") { chdir "$Mydir" || die "$Myname: can't chdir \"$Mydir\": $!"; }
chdir ".." || die "$Myname: can't chdir \"..\": $!";
$Mydir = `/bin/pwd`; chop $Mydir;
chdir $Here || die "$Myname: can't chdir \"$Here\": $!";

require "$Mydir/lib/util.pl";

$Usage = <<LIT;
$Myname: usage: $Myname
LIT


sub usage
{
  print STDERR $Usage;
  exit 1;
}


sub help
{
  print STDERR <<LIT;
$Usage
$Myname is not done yet. Be patient.
LIT
  exit 1;
}


# option switch variables get defaults here...

$Convdir = "";

$Boolopt = 0;
$Valopt = 0;

while ($#ARGV >= 0)
  {
    if ($ARGV[0] eq "-boolopt")    { $Boolopt = 1; shift; next; }
    elsif ($ARGV[0] eq "-valopt")
      {
        shift; if ($ARGV[0] < 0) { &usage; }
        $Valopt = $ARGV[0]; shift; next;
      }
    elsif ($ARGV[0] eq "-help")
      { &help; }
    elsif ($ARGV[0] =~ /^-/) { &usage; }
    push(@Args, $ARGV[0]);
    shift;
  }

if ($#Args ne 0) { &usage; }

$Convdir = $Args[0];
#chdir $Convdir || die "$Myname: can't chdir \"$Convdir\": $!";
#$Convdir = `/bin/pwd`; chop $Convdir;
#chdir $Here || die "$Myname: can't chdir \"$Here\": $!";

require "$Convdir/config";

# Load %Tags...

my %Tags;
if (-e "$Convdir/tags.txt")
  {
    if (! open(LBLMAP, "<$Convdir/tags.txt"))
      { die "Could not open \"$Convdir/tags.txt\": $!\n"; }

    while (<LBLMAP>)
      {
        chomp;
        my (@t) = split(/\s+/, $_);
        $Tags{$t[0]} = $t[1];
      }
    close LBLMAP;
    my @nmap = keys(%Tags);
    my $n = $#nmap + 1;
    print "$Myname: loaded label map; $n labels.\n";
  }

# Load @Depots...

my @Depots;
if (-e "$Convdir/depots")
  {
    if (! open(DEPOTS, "<$Convdir/depots"))
      { die "Could not open \"$Convdir/depots\": $!\n"; }

    my $n = 0;
    while (<DEPOTS>)
      {
        chomp;
        push(@Depots, $_);
        $n++;
      }
    close DEPOTS;
    print "$Myname: loaded label map; $n depots.\n";
  }


sub mklabel
{
  my ($label, @Revs) = @_;

  print "make label: $label\n";

  my $qlabel = &atq($label);
  my $time = time;

  print DBLBLS "\@pv\@ 2 \@db.domain\@ $qlabel 108 \@\@ \@\@ ".
                  "\@$CONVUSER\@ $time $time 0 0 \@Created by cvs2p4.\@\n";

  $seq = 0;
  foreach my $depot (@Depots)
    {
      # Now give it a global view (all known Depots)...
      #
      my $qlhs = &atq("//$label/$depot/...");
      my $qrhs = &atq("//$depot/...");

      print DBLBLS "\@pv\@ 1 \@db.view\@ $qlabel $seq 0 $qlhs $qrhs\n";
      $seq++;
    }
}

$Metadata = "$Convdir/metadata";
$Labels   = "$Convdir/labels";
$Rrevmap  = "$Convdir/rrevmap";
$Labelsmeta = "labelsmeta";
$Checkpoint = "checkpoint";

#  Path the the p4 client command
#
if (! defined($P4)) { $P4 = "/usr/local/bin/p4"; }
if (! -x ($P4))
  { print "$Myname: No executable \"p4\" command at \"$P4\".\n"; exit 1; }

$P4 = "$P4 -p $P4PORT -c cvs2p4 -u $P4USER";

use DB_File;
$DBMCLASS="DB_File";

#$myhashinfo = new DB_File::HASHINFO;
#$myhashinfo->{bsize} = 4096;

$myhashinfo = new DB_File::BTREEINFO;
$myhashinfo->{cachesize} = (1024 * 1024) * 256;

if (! tie(%RREVMAP, $DBMCLASS, $Rrevmap, O_RDONLY, 0444, $myhashinfo))
  { print "$Myname: can't tie \"$Rrevmap\": $!\n"; exit 1; }

if (! open(LABELS, "<$Labels"))
  { print "$Myname: can't open \">$Labels\": $!\n"; exit 1; }

#$P4D = "$P4D -r $P4ROOT";
#
#if (! open(DBLBLS, "| $P4D -jr -"))
#  { print "$Myname: can't open \"| $P4D -jr -\": $!\n"; exit 1; }

if (! open(DBLBLS, ">$P4ROOT/$Labelsmeta"))
  { print "$Myname: can't open \">$P4ROOT/$Labelsmeta\": $!\n"; exit 1; }

################################################################################
#  
#  branch_for_tag()
#
#  Please see "IMPORTING CVS TAGS AS PERFORCE LABELS" in the README
#  file for background.
#
#  If you need to supply a custom mapping function, you can
#  add your code where indicated below.
#
#  branch_for_tag() takes an RCS revision tag, and returns a list, being the name(s)
#  of the branch(s) that the revision is associated with: (It can be > 1 when it's
#  a 1.1.1.N revision that "was present in main" by virtue of no 1.2 having been
#  committed yet.
#

my %bft; # We cache the answers here for performance.

sub branch_for_tag
{
  my ($tag) = @_;

  if ($bft{$tag}) { return @{$bft{$tag}}; }

  my @Tags = split(/$S/o, $Tags{$tag});

  if ($#Tags < 0) { return (); }
  if ($#Tags == 0)
    {
      if ($Tags[0] eq "UNMAPPED")
        { $bft{$tag} = (); }
      else 
        { $bft{$tag} = ($Tags[0]); }
      return @{$bft{$tag}};
    }

  my @ret;
  foreach my $t (@Tags)
    { if ($t ne "UNMAPPED") { push(@ret, $t); } }

  $bft{$tag} = \@ret;
  return @{$bft{$tag}};
}


#  This function takes a p4path on other than "main", and returns the
#  equivalent path on "main". Note that the branch-level directory
#  might be in a different position for different depot paths, but
#  we don't currently handle that case...
#
#  Breaking news at inTouch health - the Depotmap entries now
#  contain the main branch path location! Actually gets easier!?

sub spoof_path
{
  # ($d is for passing in a debug flag):
  #
  my ($p4path, $module, $import, $mainname, $d) = @_;

  if (defined($Depotmap{$module}))
    {
      # We have a Depotmap entry - use it!
      #
      my ($path) = ($p4path =~ m/^\/\/[^\/]+\/[^\/]+\/(.*)$/);
      $p4path = "$Depotmap{$module}/$path";
    }
  else
    {
      # Not using Depotmap for this one...
      #
      $p4path =~ s%^//[^/]+/$import/(.*)$%$P4_DEPOT/$mainname/$1%;
    }

  return $p4path;
}

#
#  End of branch_for_tag() stuff...
#
################################################################################

my %Labels_seen;

my $nline = 0;
while (<LABELS>)
  {
    $nline++;
    if (($nline % 1000) == 0) { print "nline <$nline>\n"; }

    chomp $_;
    my ($label, $path, $rev, $import_as_main) = split(/$S/o, $_);

##$d = ($label eq "phoebe-4-7-0-141");

    # Make sure we have the reverse mapping for the RCS revision.
    # (I.e., the set of Perforce revisions in different branches that
    # share the RCS revision)
    #
    if (! ($revs = $RREVMAP{"$path/$rev"}))
      {
        # This can happen when there are tags on nonexistent revisions,
        # like the "x" tag in the test data set.
        #
        print "WARNING: no reverse rev map entry for RCS revision <$path/$rev> for label <$label>\n";
        next;
      }

    # Use $path to determine the cvs "module" this is from...
    #
    my ($module) = ($path =~ m/$CVS_ROOT\/([^\/]+)\//);

    my @tag_branches;

#print "HERE import_as_main [$import_as_main]\n" if $d;

    if ($import_as_main)
      { @tag_branches = ("main", $import_as_main); }
    else
      { @tag_branches = &branch_for_tag($label); }

    # Tales of true sleaze! This is how we fake the logic for totally
    # unmapped tags with DISCARD_UNMAPPED_TAGS = 0; The dummy element
    # in @tag_branches gets us into the for loop, which we will
    # execute once, and label every branch containing the label.
    #
    #
    if ($#tag_branches < 0)
      {
        if ($DISCARD_UNMAPPED_TAGS)
          { print "DROPPING UNMAPPED TAG [$_]\n"; next; }
        else
          { @tag_branches = (""); }
      }

    foreach my $tag_branch (@tag_branches)
      {
        my $spoofp4rev;
        my @emissions;

        foreach my $tryp4rev (split(/\001/, $revs))
          {
            my ($p4path, $p4rev) = ($tryp4rev =~ m/^(.*)#(.*)$/);
            
            my $p4_branch = $p4path;
    
            # Arbitrary depotmap TBD! 
            #
            ($p4_branch) = ($p4_branch =~ m/^\/\/[^\/]+\/([^\/]+)/);

            if ($tag_branch eq "$MAINNAME" && $p4_branch eq $import_as_main && $p4rev eq "1")
              {
                my $spoofpath = &spoof_path($p4path, $module, $import_as_main, $MAINNAME, $d);
                $spoofp4rev = "$spoofpath$S$p4rev";
              }

            if ($DISCARD_UNMAPPED_TAGS)
              { $emit = $tag_branch && ($tag_branch eq $p4_branch); }
            else
              { $emit = 1; }

            if ($emit)
              {
                push(@emissions, "$p4path$S$p4rev");
                if ($DISCARD_UNMAPPED_TAGS) { last; }
              }
          }

       # We need the spoof when we're looking for a main revision to tag
       # 
       if ($#emissions < 0 && $spoofp4rev)
         { push(@emissions, $spoofp4rev); }
        
       foreach my $emit (@emissions)
         {
           my ($p4path, $p4rev) = split(/$S/o, $emit);

           if (! defined($Labels_seen{$label}))
             {
               &mklabel($label);
               $Labels_seen{$label} = 1;
             }

           $p4path = &p4_esc($p4path);
           $p4path = &atq($p4path);

	   if ($Pathhacks) { $p4path = &Pathhacks($p4path); }
            
           print DBLBLS "\@pv\@ 0 \@db.label\@ \@$label\@ $p4path $p4rev\n";
         }
    
       if ($p4path eq $path) { last; }
       $p4rev = "";
     }
  }
   
close DBLBLS;
close LABELS;
untie %RREVMAP;

my $cmd = "$P4D -r $P4ROOT -jr labelsmeta";
print "$Myname> $cmd... ";
my $sts;
if ($sts = system($cmd))
  {
    print "exited with nonzero status $sts.\n";
    exit 1;
  }
print "complete.\n";

exit 0;