cvs2cl.pl

xgrafix 是PTSG模拟程序中的图形截面库 改版本是最新版本

  if ($User_Map_File)
  {
    if ( $User_Map_File =~ m{^([-\w\@+=.,\/]+):([-\w\@+=.,\/:]+)} and
         !-f $User_Map_File )
    {
      my $rsh = (exists $ENV{'CVS_RSH'} ? $ENV{'CVS_RSH'} : 'ssh');
      $User_Map_Input = "$rsh $1 'cat $2' |";
      &debug ("(run \"${User_Map_Input}\")\n");
    }
    else
    {
      $User_Map_Input = "<$User_Map_File";
    }

    open (MAPFILE, $User_Map_Input)
        or die ("Unable to open $User_Map_File ($!)");

    while (<MAPFILE>)
    {
      next if /^\s*#/;  # Skip comment lines.
      next if not /:/;  # Skip lines without colons.

      # It is now safe to split on ':'.
      my ($username, $expansion) = split ':';
      chomp $expansion;
      $expansion =~ s/^'(.*)'$/$1/;
      $expansion =~ s/^"(.*)"$/$1/;

      # If it looks like the expansion has a real name already, then
      # we toss the username we got from CVS log.  Otherwise, keep
      # it to use in combination with the email address.

      if ($expansion =~ /^\s*<{0,1}\S+@.*/) {
        # Also, add angle brackets if none present
        if (! ($expansion =~ /<\S+@\S+>/)) {
          $expansions{$username} = "$username <$expansion>";
        }
        else {
          $expansions{$username} = "$username $expansion";
        }
      }
      else {
        $expansions{$username} = $expansion;
      }
    } # fi ($User_Map_File)

    close (MAPFILE);
  }

  if (defined $User_Passwd_File)
  {
    if ( ! defined $Domain ) {
      if ( -e MAILNAME ) {
        chomp($Domain = slurp_file(MAILNAME));
      } else {
      MAILDOMAIN_CMD:
        for ([qw(hostname -d)], 'dnsdomainname', 'domainname') {
          my ($text, $exit, $sig, $core) = run_ext($_);
          if ( $exit == 0 && $sig == 0 && $core == 0 ) {
            chomp $text;
            if ( length $text ) {
              $Domain = $text;
              last MAILDOMAIN_CMD;
            }
          }
        }
      }
    }

    die "No mail domain found\n"
      unless defined $Domain;

    open (MAPFILE, "<$User_Passwd_File")
        or die ("Unable to open $User_Passwd_File ($!)");
    while (<MAPFILE>)
    {
      # all lines are valid
      my ($username, $pw, $uid, $gid, $gecos, $homedir, $shell) = split ':';
      my $expansion = '';
      ($expansion) = split (',', $gecos)
        if defined $gecos && length $gecos;

      my $mailname = $Domain eq '' ? $username : "$username\@$Domain";
      $expansions{$username} = "$expansion <$mailname>";
    }
    close (MAPFILE);
  }

  return %expansions;
}

# -------------------------------------

sub read_file_path {
  my ($line) = @_;

  my $path;

  if ( $line =~ /^Working file: (.*)/ ) {
    $path = $1;
  } elsif ( defined $RCS_Root
            and
            $line =~ m|^RCS file: $RCS_Root[/\\](.*),v$| ) {
    $path = $1;
    $path =~ s!Attic/!!;
  } else {
    return;
  }

  if ( @Ignore_Files ) {
    my $base;
    ($base, undef, undef) = fileparse($path);

    my $xpath = $Case_Insensitive ? lc($path) : $path;
    if ( grep index($path, $_) > -1, @Ignore_Files ) {
      return;
    }
  }

  return $path;
}

# -------------------------------------

sub read_symbolic_name {
  my ($line, $branch_names, $branch_numbers, $symbolic_names) = @_;

  # All tag names are listed with whitespace in front in cvs log
  # output; so if see non-whitespace, then we're done collecting.
  if ( /^\S/ ) {
    return 0;
  } else {
    # we're looking at a tag name, so parse & store it

    # According to the Cederqvist manual, in node "Tags", tag names must start
    # with an uppercase or lowercase letter and can contain uppercase and
    # lowercase letters, digits, `-', and `_'.  However, it's not our place to
    # enforce that, so we'll allow anything CVS hands us to be a tag:
    my ($tag_name, $tag_rev) = ($line =~ /^\s+([^:]+): ([\d.]+)$/);

    # A branch number either has an odd number of digit sections
    # (and hence an even number of dots), or has ".0." as the
    # second-to-last digit section.  Test for these conditions.
    my $real_branch_rev = '';
    if ( $tag_rev =~ /^(\d+\.\d+\.)+\d+$/             # Even number of dots...
         and
         $tag_rev !~ /^(1\.)+1$/ ) {                  # ...but not "1.[1.]1"
      $real_branch_rev = $tag_rev;
    } elsif ($tag_rev =~ /(\d+\.(\d+\.)+)0.(\d+)/) {  # Has ".0."
      $real_branch_rev = $1 . $3;
    }

    # If we got a branch, record its number.
    if ( $real_branch_rev ) {
      $branch_names->{$real_branch_rev} = $tag_name;
      if ( @Follow_Branches ) {
        if ( grep $_ eq $tag_name, @Follow_Branches ) {
          $branch_numbers->{$tag_name} = $real_branch_rev;
        }
      }
    } else {
      # Else it's just a regular (non-branch) tag.
      push @{$symbolic_names->{$tag_rev}}, $tag_name;
    }
  }

  return 1;
}

# -------------------------------------

sub read_revision {
  my ($line, $branch_numbers) = @_;

  my ($revision) = ( $line =~ /^revision (\d+\.[\d.]+)/ );

  return
    unless $revision;

  return $revision
    unless @Follow_Branches;

  foreach my $branch (@Follow_Branches) {
    # Special case for following trunk revisions
    return $revision
      if $branch =~ /^trunk$/i and $revision =~ /^[0-9]+\.[0-9]+$/;

    if ( my $branch_number = $branch_numbers->{$branch} ) {
      # Are we on one of the follow branches or an ancestor of same?

      # If this revision is a prefix of the branch number, or possibly is less
      # in the minormost number, OR if this branch number is a prefix of the
      # revision, then yes.  Otherwise, no.

      # So below, we determine if any of those conditions are met.

      # Trivial case: is this revision on the branch?  (Compare this way to
      # avoid regexps that screw up Emacs indentation, argh.)
      if ( substr($revision, 0, (length($branch_number) + 1))
           eq
           ($branch_number . ".") ) {
        return $revision;
      } elsif ( length($branch_number) > length($revision)
                and
                $No_Ancestors ) {
        # Non-trivial case: check if rev is ancestral to branch

        # r_left still has the trailing "."
        my ($r_left, $r_end) = ($revision =~ /^((?:\d+\.)+)(\d+)$/);

        # b_left still has trailing "."
        # b_mid has no trailing "."
        my ($b_left, $b_mid) = ($branch_number =~ /^((?:\d+\.)+)(\d+)\.\d+$/);

        return $revision
          if $r_left eq $b_left and $r_end <= $b_mid;
      }
    }
  }

  # Else we are following branches, but this revision isn't on the
  # path.  So skip it.
  return;
}

# -------------------------------------

{ # Closure over %gecos_warned
my %gecos_warned;
sub read_date_author_and_state {
  my ($line, $usermap) = @_;

  my ($time, $author, $state, $lines) = parse_date_author_and_state($line);

  if ( defined($usermap->{$author}) and $usermap->{$author} ) {
    $author = $usermap->{$author};
  } elsif ( defined $Domain or $Gecos == 1 ) {
    my $email = $author;
    $email = $author."@".$Domain
      if defined $Domain && $Domain ne '';

    my $pw = getpwnam($author);
    my ($fullname, $office, $workphone, $homephone);
    if ( defined $pw ) {
      ($fullname, $office, $workphone, $homephone) =
        split /\s*,\s*/, $pw->gecos;
    } else {
      warn "Couldn't find gecos info for author '$author'\n"
        unless $gecos_warned{$author}++;
      $fullname = '';
    }
    for (grep defined, $fullname, $office, $workphone, $homephone) {
      s/&/ucfirst(lc($pw->name))/ge;
    }
    $author = $fullname . "  <" . $email . ">"
      if $fullname ne '';
  }

  return $time, $author, $state, $lines;
}
}

# -------------------------------------

sub read_branches {
  my ($line) = @_;

  if ( $Show_Branches ) {
    my $lst = $1;
    $lst =~ s/(1\.)+1;|(1\.)+1$//;  # ignore the trivial branch 1.1.1
    if ( $lst ) {
      return split (/;\s+/, $lst);
    } else {
      return;
    }
  } else {
    # Ugh.  This really bothers me.  Suppose we see a log entry
    # like this:
    #
    #    ----------------------------
    #    revision 1.1
    #    date: 1999/10/17 03:07:38;  author: jrandom;  state: Exp;
    #    branches:  1.1.2;
    #    Intended first line of log message begins here.
    #    ----------------------------
    #
    # The question is, how we can tell the difference between that
    # log message and a *two*-line log message whose first line is
    #
    #    "branches:  1.1.2;"
    #
    # See the problem?  The output of "cvs log" is inherently
    # ambiguous.
    #
    # For now, we punt: we liberally assume that people don't
    # write log messages like that, and just toss a "branches:"
    # line if we see it but are not showing branches.  I hope no
    # one ever loses real log data because of this.
    return;
  }
}

# -------------------------------------

sub read_changelog {
  my ($command) = @_;

  my $grand_poobah = CVS::Utils::ChangeLog::EntrySet->new;

  my $file_full_path;
  my $detected_file_separator;
  my $author;
  my $revision;
  my $time;
  my $state;
  my $lines;
  my $msg_txt;

  # We might be expanding usernames
  my %usermap = maybe_read_user_map_file;

  # In general, it's probably not very maintainable to use state
  # variables like this to tell the loop what it's doing at any given
  # moment, but this is only the first one, and if we never have more
  # than a few of these, it's okay.
  my $collecting_symbolic_names = 0;
  my %symbolic_names;    # Where tag names get stored.
  my %branch_names;      # We'll grab branch names while we're at it.
  my %branch_numbers;    # Save some revisions for @Follow_Branches
  my @branch_roots;      # For showing which files are branch ancestors.

  if (! $Input_From_Stdin) {
    my $Log_Source_Command = join(' ', @$command);
    &debug ("(run \"${Log_Source_Command}\")\n");
    open (LOG_SOURCE, "$Log_Source_Command |")
        or die "unable to run \"${Log_Source_Command}\"";
  }
  else {
    open (LOG_SOURCE, "-") or die "unable to open stdin for reading";
  }

  binmode LOG_SOURCE;

 XX_Log_Source:
  while (<LOG_SOURCE>) {
    # Canonicalize line endings
    s/\r$//;

    # If on a new file and don't see filename, skip until we find it, and
    # when we find it, grab it.
    if ( ! defined $file_full_path ) {
      $file_full_path = read_file_path($_);
      next XX_Log_Source;
    } elsif ( /^symbolic names:$/ ) {
      # Collect tag names in case we're asked to print them in the output.
      $collecting_symbolic_names = 1;
      next XX_Log_Source;  # There's no more info on this line, so skip to next
    } elsif ($collecting_symbolic_names) {
      $collecting_symbolic_names =
        read_symbolic_name($_,
                           \(%branch_names, %branch_numbers, %symbolic_names));
      next XX_Log_Source;
    }

    # If have file name, but not revision, and see revision, then grab
    # it.  (We collect unconditionally, even though we may or may not
    # ever use it.)
    if ( ( ! defined $revision) ) {
      $revision = read_revision($_, \%branch_numbers);
      # This breaks, because files with no messages don't get to call clear
      # and so the file picks up messages from the next file in sequence
      #      next XX_Log_Source;
    }

    # If we don't have a revision right now, we couldn't possibly
    # be looking at anything useful.
    if (! (defined ($revision))) {
      $detected_file_separator = /^$file_separator$/o;
      if ($detected_file_separator) {
        # No revisions for this file; can happen, e.g. "cvs log -d DATE"
        goto XX_Clear;
      }
      else {
        next XX_Log_Source;
      }
    }

    # If have file name but not date and author, and see date or
    # author, then grab them:
    unless (defined $time) {
      if (/^date: .*/) {
        ($time, $author, $state, $lines) =
          read_date_author_and_state($_, \%usermap);
      } else {
        $detected_file_separator = /^$file_separator$/o;
        goto XX_Clear
          # No revisions for this file; can happen, e.g. "cvs log -d DATE"
          if $detected_file_separator;
      }

      # If the date/time/author hasn't been found yet, we couldn't
      # possibly care about anything we see.  So skip:
      next XX_Log_Source;
    }

    # A "branches: ..." line here indicates that one or more branches
    # are rooted at this revision.  If we're showing branches, then we
    # want to show that fact as well, so we collect all the branches
    # that this is the latest ancestor of and store them in
    # @branch_roots.  Just for reference, the format of the line we're
    # seeing at this point is:
    #
    #    branches:  1.5.2;  1.5.4;  ...;
    #
    # Okay, here goes:
    if ( /^branches:\s+(.*);$/ ) {
      @branch_roots = read_branches($_);
      next XX_Log_Source;
    }

    # If have file name, time, and author, then we're just grabbing
    # log message texts:
    $detected_file_separator = /^$file_separator$/o;
    if ($detected_file_separator && ! (defined $revision)) {
      # No revisions for this file; can happen, e.g. "cvs log -d DATE"
      goto XX_Clear;
    }
    unless ($detected_file_separator || /^$logmsg_separator$/o)
    {
      $msg_txt .= $_;   # Normally, just accumulate the message...
      next XX_Log_Source;
    }
    # ... until a msg separator is encountered:
    # Ensure the message contains something:
    if ((! $msg_txt)
        || ($msg_txt =~ /^\s*\.\s*$|^\s*$/)
        || ($msg_txt =~ /\*\*\* empty log message \*\*\*/))
    {
      if ($Prune_Empty_Msgs) {
        goto XX_Clear;
      }
      # else