cvs2cl.pl

RAM Defragmentation tools

      if ( -f $logfile_here ) {
        rename $logfile_here, $logfile_bak;
      }
      rename $tmpfile, $logfile_here;
    }
  }
}

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

# Don't call this wrap, because with 5.5.3, that clashes with the
# (unconditional :-( ) export of wrap() from Text::Wrap
sub mywrap {
  my $self = shift;
  my ($indent1, $indent2, @text) = @_;
  # If incoming text looks preformatted, don't get clever
  my $text = Text::Wrap::wrap($indent1, $indent2, @text);
  if ( grep /^\s+/m, @text ) {
    return $text;
  }
  my @lines = split /\n/, $text;
  $indent2 =~ s!^((?: {8})+)!"\t" x (length($1)/8)!e;
  $lines[0] =~ s/^$indent1\s+/$indent1/;
  s/^$indent2\s+/$indent2/
    for @lines[1..$#lines];
  my $newtext = join "\n", @lines;
  $newtext .= "\n"
    if substr($text, -1) eq "\n";
  return $newtext;
}

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

sub preprocess_msg_text {
  my $self = shift;
  my ($text) = @_;

  # Strip out carriage returns (as they probably result from DOSsy editors).
  $text =~ s/\r\n/\n/g;
  # If it *looks* like two newlines, make it *be* two newlines:
  $text =~ s/\n\s*\n/\n\n/g;

  return $text;
}

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

sub last_line_len {
  my $self = shift;

  my $files_list = shift;
  my @lines = split (/\n/, $files_list);
  my $last_line = pop (@lines);
  return length ($last_line);
}

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

# A custom wrap function, sensitive to some common constructs used in
# log entries.
sub wrap_log_entry {
  my $self = shift;

  my $text = shift;                  # The text to wrap.
  my $left_pad_str = shift;          # String to pad with on the left.

  # These do NOT take left_pad_str into account:
  my $length_remaining = shift;      # Amount left on current line.
  my $max_line_length  = shift;      # Amount left for a blank line.

  my $wrapped_text = '';             # The accumulating wrapped entry.
  my $user_indent = '';              # Inherited user_indent from prev line.

  my $first_time = 1;                # First iteration of the loop?
  my $suppress_line_start_match = 0; # Set to disable line start checks.

  my @lines = split (/\n/, $text);
  while (@lines)   # Don't use `foreach' here, it won't work.
  {
    my $this_line = shift (@lines);
    chomp $this_line;

    if ($this_line =~ /^(\s+)/) {
      $user_indent = $1;
    }
    else {
      $user_indent = '';
    }

    # If it matches any of the line-start regexps, print a newline now...
    if ($suppress_line_start_match)
    {
      $suppress_line_start_match = 0;
    }
    elsif (($this_line =~ /^(\s*)\*\s+[a-zA-Z0-9]/)
           || ($this_line =~ /^(\s*)\* [a-zA-Z0-9_\.\/\+-]+/)
           || ($this_line =~ /^(\s*)\([a-zA-Z0-9_\.\/\+-]+(\)|,\s*)/)
           || ($this_line =~ /^(\s+)(\S+)/)
           || ($this_line =~ /^(\s*)- +/)
           || ($this_line =~ /^()\s*$/)
           || ($this_line =~ /^(\s*)\*\) +/)
           || ($this_line =~ /^(\s*)[a-zA-Z0-9](\)|\.|\:) +/))
    {
      # Make a line break immediately, unless header separator is set
      # and this line is the first line in the entry, in which case
      # we're getting the blank line for free already and shouldn't
      # add an extra one.
      unless (($After_Header ne " ") and ($first_time))
      {
        if ($this_line =~ /^()\s*$/) {
          $suppress_line_start_match = 1;
          $wrapped_text .= "\n${left_pad_str}";
        }

        $wrapped_text .= "\n${left_pad_str}";
      }

      $length_remaining = $max_line_length - (length ($user_indent));
    }

    # Now that any user_indent has been preserved, strip off leading
    # whitespace, so up-folding has no ugly side-effects.
    $this_line =~ s/^\s*//;

    # Accumulate the line, and adjust parameters for next line.
    my $this_len = length ($this_line);
    if ($this_len == 0)
    {
      # Blank lines should cancel any user_indent level.
      $user_indent = '';
      $length_remaining = $max_line_length;
    }
    elsif ($this_len >= $length_remaining) # Line too long, try breaking it.
    {
      # Walk backwards from the end.  At first acceptable spot, break
      # a new line.
      my $idx = $length_remaining - 1;
      if ($idx < 0) { $idx = 0 };
      while ($idx > 0)
      {
        if (substr ($this_line, $idx, 1) =~ /\s/)
        {
          my $line_now = substr ($this_line, 0, $idx);
          my $next_line = substr ($this_line, $idx);
          $this_line = $line_now;

          # Clean whitespace off the end.
          chomp $this_line;

          # The current line is ready to be printed.
          $this_line .= "\n${left_pad_str}";

          # Make sure the next line is allowed full room.
          $length_remaining = $max_line_length - (length ($user_indent));

          # Strip next_line, but then preserve any user_indent.
          $next_line =~ s/^\s*//;

          # Sneak a peek at the user_indent of the upcoming line, so
          # $next_line (which will now precede it) can inherit that
          # indent level.  Otherwise, use whatever user_indent level
          # we currently have, which might be none.
          my $next_next_line = shift (@lines);
          if ((defined ($next_next_line)) && ($next_next_line =~ /^(\s+)/)) {
            $next_line = $1 . $next_line if (defined ($1));
            # $length_remaining = $max_line_length - (length ($1));
            $next_next_line =~ s/^\s*//;
          }
          else {
            $next_line = $user_indent . $next_line;
          }
          if (defined ($next_next_line)) {
            unshift (@lines, $next_next_line);
          }
          unshift (@lines, $next_line);

          # Our new next line might, coincidentally, begin with one of
          # the line-start regexps, so we temporarily turn off
          # sensitivity to that until we're past the line.
          $suppress_line_start_match = 1;

          last;
        }
        else
        {
          $idx--;
        }
      }

      if ($idx == 0)
      {
        # We bottomed out because the line is longer than the
        # available space.  But that could be because the space is
        # small, or because the line is longer than even the maximum
        # possible space.  Handle both cases below.

        if ($length_remaining == ($max_line_length - (length ($user_indent))))
        {
          # The line is simply too long -- there is no hope of ever
          # breaking it nicely, so just insert it verbatim, with
          # appropriate padding.
          $this_line = "\n${left_pad_str}${this_line}";
        }
        else
        {
          # Can't break it here, but may be able to on the next round...
          unshift (@lines, $this_line);
          $length_remaining = $max_line_length - (length ($user_indent));
          $this_line = "\n${left_pad_str}";
        }
      }
    }
    else  # $this_len < $length_remaining, so tack on what we can.
    {
      # Leave a note for the next iteration.
      $length_remaining = $length_remaining - $this_len;

      if ($this_line =~ /\.$/)
      {
        $this_line .= "  ";
        $length_remaining -= 2;
      }
      else  # not a sentence end
      {
        $this_line .= " ";
        $length_remaining -= 1;
      }
    }

    # Unconditionally indicate that loop has run at least once.
    $first_time = 0;

    $wrapped_text .= "${user_indent}${this_line}";
  }

  # One last bit of padding.
  $wrapped_text .= "\n";

  return $wrapped_text;
}

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

sub _pretty_file_list {
  my $self = shift;

  my ($unanimous_tags, $non_unanimous_tags, $all_branches, $qunksref) = @_;

  my @qunkrefs =
    grep +( ( ! $_->tags_exists
              or
              ! grep exists $ignore_tags{$_}, @{$_->tags})
            and
            ( ! keys %show_tags
              or
              ( $_->tags_exists
                and
                grep exists $show_tags{$_}, @{$_->tags} )
            )
          ),
    @$qunksref;

  my $common_dir;           # Dir prefix common to all files ('' if none)

  # First, loop over the qunks gathering all the tag/branch names.
  # We'll put them all in non_unanimous_tags, and take out the
  # unanimous ones later.
 QUNKREF:
  foreach my $qunkref (@qunkrefs)
  {
    # Keep track of whether all the files in this commit were in the
    # same directory, and memorize it if so.  We can make the output a
    # little more compact by mentioning the directory only once.
    if ($Common_Dir && (scalar (@qunkrefs)) > 1)
    {
      if (! (defined ($common_dir)))
      {
        my ($base, $dir);
        ($base, $dir, undef) = fileparse ($qunkref->filename);

        if ((! (defined ($dir)))  # this first case is sheer paranoia
            or ($dir eq '')
            or ($dir eq "./")
            or ($dir eq ".\\"))
        {
          $common_dir = '';
        }
        else
        {
          $common_dir = $dir;
        }
      }
      elsif ($common_dir ne '')
      {
        # Already have a common dir prefix, so how much of it can we preserve?
        $common_dir = &main::common_path_prefix ($qunkref->filename, $common_dir);
      }
    }
    else  # only one file in this entry anyway, so common dir not an issue
    {
      $common_dir = '';
    }

    if (defined ($qunkref->branch)) {
      $all_branches->{$qunkref->branch} = 1;
    }
    if (defined ($qunkref->tags)) {
      foreach my $tag (@{$qunkref->tags}) {
        $non_unanimous_tags->{$tag} = 1;
      }
    }
  }

  # Any tag held by all qunks will be printed specially... but only if
  # there are multiple qunks in the first place!
  if ((scalar (@qunkrefs)) > 1) {
    foreach my $tag (keys (%$non_unanimous_tags)) {
      my $everyone_has_this_tag = 1;
      foreach my $qunkref (@qunkrefs) {
        if ((! (defined ($qunkref->tags)))
            or (! (grep ($_ eq $tag, @{$qunkref->tags})))) {
          $everyone_has_this_tag = 0;
        }
      }
      if ($everyone_has_this_tag) {
        $unanimous_tags->{$tag} = 1;
        delete $non_unanimous_tags->{$tag};
      }
    }
  }

  return $common_dir, \@qunkrefs;
}

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

sub fdatetime {
  my $self = shift;

  my ($year, $mday, $mon, $wday, $hour, $min);

  if ( @_ > 1 ) {
    ($year, $mday, $mon, $wday, $hour, $min) = @_;
  } else {
    my ($time) = @_;
    (undef, $min, $hour, $mday, $mon, $year, $wday) =
      $UTC_Times ? gmtime($time) : localtime($time);

    $year += 1900;
    $mon  += 1;
    $wday  = $self->wday($wday);
  }

  my $fdate = $self->fdate($year, $mon, $mday, $wday);

  if ($Show_Times) {
    my $ftime = $self->ftime($hour, $min);
    return "$fdate $ftime";
  } else {
    return $fdate;
  }
}

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

sub fdate {
  my $self = shift;

  my ($year, $mday, $mon, $wday);

  if ( @_ > 1 ) {
    ($year, $mon, $mday, $wday) = @_;
  } else {
    my ($time) = @_;
    (undef, undef, undef, $mday, $mon, $year, $wday) =
      $UTC_Times ? gmtime($time) : localtime($time);

    $year += 1900;
    $mon  += 1;
    $wday  = $self->wday($wday);
  }

  return sprintf '%4u-%02u-%02u%s', $year, $mon, $mday, $wday;
}

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

sub ftime {
  my $self = shift;

  my ($hour, $min);

  if ( @_ > 1 ) {
    ($hour, $min) = @_;
  } else {
    my ($time) = @_;
    (undef, $min, $hour) = $UTC_Times ? gmtime($time) : localtime($time);
  }

  return sprintf '%02u:%02u', $hour, $min;
}

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

package CVS::Utils::ChangeLog::Message;

sub new {
  my $class = shift;
  my ($msg) = @_;

  my %self = (msg => $msg, files => []);

  bless \%self, $class;
}

sub add_fileentry {
  my $self = shift;
  my ($fileentry) = @_;

  die "Not a fileentry: $fileentry"
    unless $fileentry->isa('CVS::Utils::ChangeLog::FileEntry');

  push @{$self->{files}}, $fileentry;
}

sub files { wantarray ? @{$_[0]->{files}} : $_[0]->{files} }

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

package CVS::Utils::ChangeLog::FileEntry;

# Each revision of a file has a little data structure (a `qunk')
# associated with it.  That data structure holds not only the
# file's name, but any additional information about the file
# that might be needed in the output, such as the revision
# number, tags, branches, etc.  The reason to have these things
# arranged in a data structure, instead of just appending them
# textually to the file's name, is that we may want to do a
# little rearranging later as we write the output.  For example,
# all the files on a given tag/branch will go together, followed
# by the tag in parentheses (so trunk or otherwise non-tagged
# files would go at the end of the file list for a given log