cvs2cl.pl

RAM Defragmentation tools

# message).  This rearrangement is a lot easier to do if we
# don't have to reparse the text.
#
# A qunk looks like this:
#
#   {
#     filename    =>    "hello.c",
#     revision    =>    "1.4.3.2",
#     time        =>    a timegm() return value (moment of commit)
#     tags        =>    [ "tag1", "tag2", ... ],
#     branch      =>    "branchname" # There should be only one, right?
#     roots       =>    [ "branchtag1", "branchtag2", ... ]
#     lines       =>    "+x -y" # or undefined; x and y are integers
#   }

# Single top-level ChangeLog, or one per subdirectory?
my $distributed;
sub distributed { $#_ ? ($distributed = $_[1]) : $distributed; }

sub new {
  my $class = shift;
  my ($path, $time, $revision, $state, $lines,
      $branch_names, $branch_roots, $branch_numbers, $symbolic_names) = @_;

  my %self = (time     => $time,
              revision => $revision,
              state    => $state,
              lines    => $lines,
              branch_numbers => $branch_numbers,
             );

  if ( $distributed ) {
    @self{qw(filename dir_key)} = fileparse($path);
  } else {
    @self{qw(filename dir_key)} = ($path, './');
  }

  { # Scope for $branch_prefix
    (my ($branch_prefix) = ($revision =~ /((?:\d+\.)+)\d+/));
    $branch_prefix =~ s/\.$//;
    if ( $branch_names->{$branch_prefix} ) {
      my $branch_name = $branch_names->{$branch_prefix};
      $self{branch}   = $branch_name;
      $self{branches} = [$branch_name];
    }
    while ( $branch_prefix =~ s/^(\d+(?:\.\d+\.\d+)+)\.\d+\.\d+$/$1/ ) {
      push @{$self{branches}}, $branch_names->{$branch_prefix}
        if exists $branch_names->{$branch_prefix};
    }
  }

  # If there's anything in the @branch_roots array, then this
  # revision is the root of at least one branch.  We'll display
  # them as branch names instead of revision numbers, the
  # substitution for which is done directly in the array:
  $self{'roots'} = [ map { $branch_names->{$_} } @$branch_roots ]
    if @$branch_roots;

  if ( exists $symbolic_names->{$revision} ) {
    $self{tags} = delete $symbolic_names->{$revision};
    &main::delta_check($time, $self{tags});
  }

  bless \%self, $class;
}

sub filename       { $_[0]->{filename}       }
sub dir_key        { $_[0]->{dir_key}        }
sub revision       { $_[0]->{revision}       }
sub branch         { $_[0]->{branch}         }
sub state          { $_[0]->{state}          }
sub lines          { $_[0]->{lines}          }
sub roots          { $_[0]->{roots}          }
sub branch_numbers { $_[0]->{branch_numbers} }

sub tags        { $_[0]->{tags}     }
sub tags_exists {
  exists $_[0]->{tags};
}

# This may someday be used in a more sophisticated calculation of what other
# files are involved in this commit.  For now, we don't use it much except for
# delta mode, because the common-commit-detection algorithm is hypothesized to
# be "good enough" as it stands.
sub time     { $_[0]->{time}     }

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

package CVS::Utils::ChangeLog::EntrySetBuilder;

use File::Basename qw( fileparse );
use Time::Local    qw( timegm );

use constant MAILNAME => "/etc/mailname";

# In 'cvs log' output, one long unbroken line of equal signs separates files:
use constant FILE_SEPARATOR => '=' x 77;# . "\n";
# In 'cvs log' output, a shorter line of dashes separates log messages within
# a file:
use constant REV_SEPARATOR  => '-' x 28;# . "\n";

use constant EMPTY_LOG_MESSAGE => '*** empty log message ***';

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

sub new {
  my ($proto) = @_;
  my $class = ref $proto || $proto;

  my $poobah  = CVS::Utils::ChangeLog::EntrySet->new;
  my $self = bless +{ grand_poobah => $poobah }, $class;

  $self->clear_file;
  $self->maybe_read_user_map_file;
  return $self;
}

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

sub clear_msg {
  my ($self) = @_;

  # Make way for the next message
  undef $self->{rev_msg};
  undef $self->{rev_time};
  undef $self->{rev_revision};
  undef $self->{rev_author};
  undef $self->{rev_state};
  undef $self->{lines};
  $self->{rev_branch_roots} = [];       # For showing which files are branch
                                        # ancestors.
  $self->{collecting_symbolic_names} = 0;
}

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

sub clear_file {
  my ($self) = @_;
  $self->clear_msg;

  undef $self->{filename};
  $self->{branch_names}   = +{};        # We'll grab branch names while we're
                                        # at it.
  $self->{branch_numbers} = +{};        # Save some revisions for
                                        # @Follow_Branches
  $self->{symbolic_names} = +{};        # Where tag names get stored.
}

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

sub grand_poobah { $_[0]->{grand_poobah} }

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

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

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

  if (! $Input_From_Stdin) {
    my $Log_Source_Command = join(' ', @$command);
    &main::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>) {
    chomp;

    # If on a new file and don't see filename, skip until we find it, and
    # when we find it, grab it.
    if ( ! defined $self->{filename} ) {
      $self->read_file_path($_);
    } elsif ( /^symbolic names:$/ ) {
      $self->{collecting_symbolic_names} = 1;
    } elsif ( $self->{collecting_symbolic_names} ) {
      $self->read_symbolic_name($_);
    } elsif ( $_ eq FILE_SEPARATOR and ! defined $self->{rev_revision} ) {
      $self->clear_file;
    } elsif ( ! defined $self->{rev_revision} ) {
        # 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.)
      $self->read_revision($_);
    } elsif ( ! defined $self->{rev_time} ) { # and /^date: /) {
      $self->read_date_author_and_state($_);
    } elsif ( /^branches:\s+(.*);$/ ) {
      $self->read_branches($1);
    } elsif ( ! ( $_ eq FILE_SEPARATOR or $_ eq REV_SEPARATOR ) ) {
      # If have file name, time, and author, then we're just grabbing
      # log message texts:
      $self->{rev_msg} .= $_ . "\n";   # Normally, just accumulate the message...
    } else {
      if ( ! $self->{rev_msg}
           or $self->{rev_msg} =~ /^\s*(\.\s*)?$/
           or index($self->{rev_msg}, EMPTY_LOG_MESSAGE) > -1 ) {
        # ... until a msg separator is encountered:
        # Ensure the message contains something:
        $self->clear_msg
          if $Prune_Empty_Msgs;
        $self->{rev_msg} = "[no log message]\n";
      }

      $self->add_file_entry;

      if ( $_ eq FILE_SEPARATOR ) {
        $self->clear_file;
      } else {
        $self->clear_msg;
      }
    }
  }

  close LOG_SOURCE
    or die sprintf("Problem reading log input (exit/signal/core: %d/%d/%d)\n",
                   $? >> 8, $? & 127, $? & 128);
  return;
}

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

sub add_file_entry {
  $_[0]->grand_poobah->add_fileentry(@{$_[0]}{qw(filename rev_time rev_revision
                                                 rev_state lines branch_names
                                                 rev_branch_roots
                                                 branch_numbers
                                                 symbolic_names
                                                 rev_author rev_msg)});
}

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

sub maybe_read_user_map_file {
  my ($self) = @_;

  my %expansions;
  my $User_Map_Input;

  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' |";
      &main::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);
  }

 $self->{usermap} = \%expansions;
}

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

sub read_file_path {
  my ($self, $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 ) {
    if ( grep(($path eq $_), @Ignore_Files) ) {
      return;
    }
  }

  $self->{filename} = $path;
  return;
}

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

sub read_symbolic_name {
  my ($self, $line) = @_;

  # 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/ ) {
    $self->{collecting_symbolic_names} = 0;
    return;
  } 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 ) {
      $self->{branch_names}->{$real_branch_rev} = $tag_name;
      $self->{branch_numbers}->{$tag_name} = $real_branch_rev;
    } else {
      # Else it's just a regular (non-branch) tag.
      push @{$self->{symbolic_names}->{$tag_rev}}, $tag_name;
    }
  }

  $self->{collecting_symbolic_names} = 1;
  return;
}

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

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

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

  return
    unless $revision;

  $self->{rev_revision} = $revision;
  return;
}

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

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

  my ($time, $author, $state) = $self->parse_date_author_and_state($line);

  if ( defined($self->{usermap}->{$author}) and $self->{usermap}->{$author} ) {
    $author = $self->{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 ) {
      ($full