map #8

#!/usr/local/bin/perl
# -*-Fundamental-*-

#  Inputs:
#    ../tags.txt		...if present, for "GLTAGS" override.
#    tags.txt			...for module-determined tags
#    brtags.txt			...module's branch tags.
#    [../]exclude_tags          ...from ./ if present, else from ../
#    [../]exclude_branches      ...from ./ if present, else from ../
#    [../]brmap.pl		...from ./ if present, else from ../
#

# A script to read the brtags.txt and tags.txt files generated by genmetadata,
# and summarize the state of label mapping for the converison.
#
# To use it, cd into your conversion directory, and invoke it!
#

# By default, it will prefer the heuristic results over the mapping
# function results; With -d, it will show collisions between the
# heuristic and mapping function results.
#

my $details = 0;
if ($ARGV[0] eq "-d") { $details = 1; }


#  This is how we pick up the &brmap function from
#  brmap.pl (if present).
#
my $mpath = "";
if (-f "brmap.pl")
  { $mpath = "brmap.pl"; }
elsif (-f "../brmap.pl")
  { $mpath = "../brmap.pl"; }

if ($mpath)
  {
    if (! open(BRMAP, "<$mpath"))
      {
        print "$Myname: open \"<brmap.pl\" failed: $!.\n";
        exit 1;
      }

    my $brmap_pl;
    { local $/; $brmap_pl = <BRMAP>; }

    close BRMAP;

    my $evret;
    eval $brmap_pl;
    if ($@)
      {
        print "eval rmap.pl failed: $@\n";
        exit 1;
      }
    print "eval'ed brmap.pl ok.\n\n";
  }

#  Now load the brtags.txt file... this is required context for
#  any mapping functions supplied in brmap.pl:
#
open(BRTAGS, "<brtags.txt") || die "can't open brtags.txt";

while (<BRTAGS>)
  {
    chomp;
    $Brtags{$_} = 1;
  }

close BRTAGS;

# This hackery is here to support being able to use a "depot-global"
# mapping file in conjunction with separate conversion of separate
# modules:
#
my $have_global_tags = 0;
my %GLTAGS;
if (-f "../tags.txt")
  {
    open(GLTAGS, "<../tags.txt") || die;
    while (<GLTAGS>)
      {
        chomp;
        my ($tag, $mapping) = split(/\s+/, $_);
        $GLTAGS{$tag} = $mapping;
      }
    close GLTAGS;
    $have_global_tags = 1;    
  }

#  Since the exclude lists are honored in genmetadata, excluded things
#  won't make it past that stage, so in usage where "map" is only
#  run after genmetadata, no excluded branches or tags should be visible
#  in br/tags.txt. BUT: we like to use this for previewing the effect of
#  changes to the exclude lists, so we will also honor them here...
#

sub load_excludes
{
  my $epath = "";
  if (-f "../exclude_tags")
    { $epath = "../exclude_tags"; }
  elsif (-f "exclude_tags")
    { $epath = "exclude_tags"; }

  if ($epath)
    {
      if (! open(EXCLTAGS, "<$epath"))
        {
          printf STDERR "open(\"<$epath\" failed: $!\n";
          exit 1;
        }
      $ntags = 0;
      while (<EXCLTAGS>)
        {
          chomp $_;
          if (/^\s*#/ || /^\s*$/) { next; }
          $_ =~ s/^\s*//;
          $_ =~ s/\s*#.*$//;
          $Exclude_tags{$_} = 1;
          $ntags++;
        }
      close EXCLTAGS;
      print "loaded exclude_tags ($ntags tags).\n";
    }

  my $epath = "";
  if (-f "../exclude_branches")
    { $epath = "../exclude_branches"; }
  elsif (-f "exclude_branches")
    { $epath = "exclude_branches"; }
  if ($epath)
    {
      if (! open(EXCLTAGS, "<$epath"))
        {
          printf STDERR "open(\"<$epath\" failed: $!\n";
          exit 1;
        }

     $ntags = 0;
      while (<EXCLTAGS>)
        {
          chomp $_;
          if (/^\s*#/ || /^\s*$/) { next; }
          $_ =~ s/^\s*//;
          $_ =~ s/\s*#.*$//;
          $Exclude_branches{$_} = 1;
          $ntags++;
        }
      close EXCLTAGS;
      print "loaded exclude_branches ($ntags tags).\n";
    }
  print "\n";
}

&load_excludes();

# Now pick up tags.txt...

open(TAGS, "<tags.txt") || die;

while (<TAGS>)
  {
    chomp;

    # Since this is from tags.txt, $mapping wil be the heuristically
    # determined result, if one was found, or "UNMAPPED":
    #
    ($tag, $mapping) = split(/\t+/, $_);

    # Ignore excluded tags:
    # (account for these skips in the output TBD)
    #
    if (defined($Exclude_tags{$tag}))
      {
        print "skip excluded tag <$tag>\n";
        next;
      }

    if ($have_global_tags)
      {
        # Assert that all tags should be present in the global list:
        #
        if (! defined($GLTAGS{$tag})) { die "tag $tag> missing in global map!\n"; }
        $mapping = $GLTAGS{$tag};
      }

    # Now see what the mapping functions yield...
    #
    if ( ! ($branch = &brmap($tag))) { $branch = "UNMAPPED"; }
    
    if ($mapping eq "UNMAPPED" && $branch eq "UNMAPPED")
      {
        # Nothing has mapped it yet, could it be a "branchpoint tag?"
        #
        if ($tag =~ /[_\-]branch[_\-]?point$/i 
              || $tag =~ /[_\-]bp$/i
              || $tag =~ /^branch[_\-]point/i
              || $tag =~ /[_\-]br[_\-](point|base)$/i)
          { $result = "BRANCHPOINT-DROPPED"; }
        else
          { $result = "UNMAPPED"; }
      }
    elsif ($mapping eq "UNMAPPED")
      { $result = "$branch [F]"; }
    elsif ($branch eq "UNMAPPED")
      { $result = "$mapping [H]"; }
    elsif ($branch eq $mapping)
      { $result = "$branch [B]"; }
    else
      {
        if ($details)
          { $result = "F-B-COLLISION"; }
        else
          { $result = "$mapping [H]"; }
      }

    my $res_branch = $result;
    $res_branch =~ s/ \[[A-Z]\]$//;

    # This is where we weed out branches on the exclude_branches list...
    #
    if (defined($Exclude_branches{$res_branch}))
      {
        print "skip excluded branch <$res_branch>\n";
        next;
      }

    # Get here with result for this mapping in $result:
    #
    $out .= "$tag\t$mapping\t$branch\t$result\n";

    if (! defined($tally{$result}))
      { $tally{$result} = 1; }
    else
      { $tally{$result}++; }
  }

$tot = 0;
$nmapped = 0;
$nother = 0;
foreach my $key (sort(keys(%tally)))
  {
    if ($key =~ /^(UNMAPPED|F-B-COLLISION|BRANCHPOINT-DROPPED)$/)
      { printf ("%20s %d\n", $key, $tally{$key}); }

    elsif ($key =~ /\[/)
      { $nmapped += $tally{$key}; }
    else
      { $nother += $tally{$key}; } 

    $tot += $tally{$key};
  }

printf ("%20s %d\n", "mapped", $nmapped);
printf ("%20s %d\n", "other", $nother);
printf ("%20s %d\n", "total tags", $tot);
print "\n\n";
print($out);

exit(0);