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;
}


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

  print "make label: $label\n";

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

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

#  foreach my $rev (@Revs)
#    {
#      my ($f, $r) = ($rev =~ /^(.*)#(\d+)$/);
#      $f = &p4_esc($f);
#      $f = &atq($f);
#      print DBLBLS "\@pv\@ 0 \@db.label\@ $label $f $r\n";
#    }
}


# 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";

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

    while (<LBLMAP>)
      {
        $_ =~ s/[\n\r]+$//;
        my ($label, $branch) = split(/\t/, $_);
        if ($branch ne "UNMAPPED") { $labelmap{$label} = $branch; }
      }
    close LBLMAP;
    my @nmap = keys(%labelmap);
    my $n = $#nmap + 1;
    print "$Myname: loaded label map; $n labels.\n";
  }

$Metadata = "$Convdir/metadata";
$Labels   = "$Convdir/labels";
$Rrevmap  = "$Convdir/rrevmap";
#$DBlbls   = "$P4ROOT/dblbls";
$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;

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; }

#  Open the db metadata (journal format) file we will write
#
#$DBlbls =~ s%^.*/%%;

$P4D = "$P4D -r .";

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

#if (&s("cd $P4ROOT && $P4D -jr $DBlbls"))
#  { print "$Myname: \"$P4D -jr $DBlbls\" failed.\n"; exit 1; }

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

################################################################################
#  
#  branch_for_tag()
#
#  Due to differences in the way Perforce and RCS/CVS work, Perforce
#  cannot know, by looking at the RCS archive alone, which branch(s) a
#  given label applies to. The default, in essence, is to make tags
#  for ALL branches to which it _could_ apply. This results in huge
#  numbers of often useless labels, and long "dolabels" phases.
#  
#  Often, however, the day can be saved, IF the user can provide a
#  mapping function that can take a label name and map it to a branch
#  name, along with a function that can take a Perforce revision
#  (pathname and revision number), and a branch name, and return an
#  indication of whether the revision given is in fact on the branch
#  given. (The latter function is usually trivially easy).
#
#  If you want to use this feature, you will need to uncomment and
#  modify the following two functions to match your data.
#
#  The first takes an RCS revision tag, and returns the name of the
#  branch that the revision is associated with:
#

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

  #  These are a couple of example mappings, in this case based
  #  on the format of the tag names themselves (but your function
  #  is free to use any method you can devise):
  #  
  #  if ($tag =~ /^v(\d+)_(\d+)_([dab])_(\d)+$/)  { return "main"; }
  #  if ($tag =~ /^(branch_.*)_\d\d\d$/) { return $1; }

  #  ADD YOUR CODE HERE
  if (defined($labelmap{$tag})) { return $labelmap{$tag}; }

  #  Sorry, can't map this one I guess.
  #
  return "";
}

#  The second function you need to pay attention to is rev_on_branch().
#
#  Usually, this will be just as shown here, where it involves
#  comparing a component of the revision's pathname (i.e., the
#  "branch-level directory" in Perforce, with the given $tag_branch.
#  The result of the comparison is the result of the function.
#
#  If your conversion uses the default arrangement in the cvs2p4
#  config file, so that the third pathname component is the branch
#  name, e.g.,
#
#    //depot/<module>/<branch>/...
#
#  you won't need to change this at all:
#  

sub rev_on_branch
{
  my ($rev, $tag_branch) = @_;
  my ($branch) = ($rev =~ /^\/\/depot\/[^\/]+\/([^\/]+)\//);
  return ($branch eq $tag_branch);
}

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

my %Labels_seen;
while (<LABELS>)
  {
    chomp $_;
    my ($label, $path, $rev) = split(/$S/, $_);

    my $tag_branch;
    if (defined(&branch_for_tag))
      { $tag_branch = &branch_for_tag($label); }

    if ($DISCARD_UNMAPPED_TAGS && ((! $tag_branch) || $tag_branch eq "UNMAPPED")) { next; }

    # Also, 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;
      }

    my $nbranches = 0;
    foreach my $tryp4rev (split(/\001/, $revs))
      {
        my ($p4path, $p4rev) = ($tryp4rev =~ m/^(.*)#(.*)$/);
        
        my $p4_branch = $p4path;
        ($p4_branch) =~ /^$P4_DEPOT\/([^\/]+)/;

        if ($DISCARD_UNMAPPED_TAGS == 0 || $tag_branch eq $p4_branch)
          {
            if (! defined($Labels_seen{$label}))
              {
                &mklabel($label);
                $Labels_seen{$label} = 1;
              }
            $p4path = &p4_esc($p4path);
            $p4path = &atq($p4path);
            
            print DBLBLS "\@pv\@ 0 \@db.label\@ \@$label\@ $p4path $p4rev\n";

            $nbranches++;
            if ($tag_branch eq $p4_branch) { last; }
          }

        if ($p4path eq $path) { last; }
        $p4rev = "";
      }
    
    # I have never seen this yet, so will leave it as a sudden death
    # for now.
    #
    if ($nbranches == 0)
      { die "assert: no reverse rev map entry match for RCS revision <$path/$rev>!\n"; }

#        if ($revs = $RREVMAP{$tag})
#          {
#	    # GOAL: determine the branch this tag is for
#            #       (which is encoded in the tag name),
#            #       and only do the push for the revision
#            #       in $revs that is on the branch it belongs
#            #       to....
#            #
#
#            if (defined(&branch_for_tag))
#              {
#                $tag_branch = &branch_for_tag($label);
#                # comment out the next line to handle unmapped tags;
#                # leave in to exclude them from the import entirely.
# 		#
#                #if (! $tag_branch) { next; }
#              }
#
#            my $have_n = 0;
#            foreach $rev (split(/\001/, $revs))
#              {
#                if ((! defined(&branch_for_tag)) || (! $tag_branch) || &rev_on_branch($rev, $tag_branch))
#                  { push (@Revs, $rev); $have_n++; }
#              }
#
#            if (! $have_n)
#              {
#                foreach $rev (split(/\001/, $revs))
#                  { push (@Revs, $rev); $have_n++; }
#              }
#          }
#      }
  }
   
#if ($#Revs >= 0) { &mklabel($label, @Revs); }

close DBLBLS;
close LABELS;
untie %RREVMAP;

#if (&s("cd $P4ROOT && rm -f $Checkpoint; $P4D -jd $Checkpoint"))
#  { print "$Myname: \"$P4D -jd $Checkpoint\" failed.\n"; exit 1; }

exit 0;