map #5

  • //
  • guest/
  • richard_geiger/
  • utils/
  • cvs2p4/
  • bin/
  • map
  • View
  • Commits
  • Open Download .zip Download (4 KB)
#!/usr/local/bin/perl
# -*-Fundamental-*-

# 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).
#
if (-f "brmap.pl")
  {
    if (! open(BRMAP, "<brmap.pl"))
      {
        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 tag.txt file...
#

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 %GLTAGS;
#open(GLTAGS, "<../tags.txt") || die;
#while (<GLTAGS>)
#  {
#    chomp;
#    my ($tag, $mapping) = split(/\s+/, $_);
#    $GLTAGS{$tag} = $mapping;
#  }
#close GLTAGS;

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+/, $_);

#    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"; }
    
# move into brmap.pl
#    if ($tag =~ /^(.*)-\d{3}$/ && $Brtags{"$1-br"})
#      { $branch = "$1-br"; }
#    elsif ($tag =~ /^OLDphoebe-\d\d\d[a-z]{0,1}-(\d+-\d+)$/ && $Brtags{"OLDphoebe-$1-br"})
#      { $branch = "OLDphoebe-$1-br"; }

#    if ($result eq "UNMAPPED" || $result eq "F-B-COLLISION")
#      {
#        if    ($tag =~ /^OLDphoebe-2-0-/) { $result = "OLDphoebe-2-0-br [M]"; }
#        elsif ($tag =~ /^cp-1-/) { $result = "main [M]"; }
#
#      }

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

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

# Change User Description Committed
#17 5688 Richard Geiger consistently invoke perl via PATH
#16 5616 Richard Geiger a fix for precision!
#15 5563 Richard Geiger Life is a corner case.
"UNMAPPED-COLLISION tags in tags.txt now indicate what collided better.
Fix srcdiff to handle odd Log expansion corner case that was causing
flase positives.
#14 5496 Richard Geiger recognize "*-base" as branch points.
#13 5493 Richard Geiger update
#12 5492 Richard Geiger Use excludes lists correctly!
#11 5491 Richard Geiger checkpoint
#10 5489 Richard Geiger New checkpoint; now has multi-mod exclude_* files.
#9 5475 Richard Geiger Treat tags missing in the global map as warnings,
and print html-friendly messages.
#8 5474 Richard Geiger honer exclude files.
#7 5473 Richard Geiger checkpoint.
#6 5471 Richard Geiger Try using either brmap.pl or ../brmap.pl
#5 5470 Richard Geiger The Neverending Story.
#4 5453 Richard Geiger checkpoint
#3 5449 Richard Geiger gearing up for 2.6.0 release...
#2 5441 Richard Geiger checkpoint.
#1 5440 Richard Geiger branch mapping adjunct, for summarizing the
coverage from the heuristic plus any mappingfunctions.
Prerelease!