cvs2cl.pl

RAM Defragmentation tools

  unless ( $No_Wrap ) {
    # Strip off lone newlines, but only for lines that don't begin with
    # whitespace or a mail-quoting character, since we want to preserve
    # that kind of formatting.  Also don't strip newlines that follow a
    # period; we handle those specially next.  And don't strip
    # newlines that precede an open paren.
    1 while $text =~ s/(^|\n)([^>\s].*[^.\n])\n([^>\n])/$1$2 $3/g;

    # If a newline follows a period, make sure that when we bring up the
    # bottom sentence, it begins with two spaces.
    1 while $text =~ s/(^|\n)([^>\s].*)\n([^>\n])/$1$2  $3/g;
  }

  return $text;
}

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

# Here we take a bunch of qunks and convert them into printed
# summary that will include all the information the user asked for.
sub pretty_file_list {
  my $self = shift;

  return ''
    if $Hide_Filenames;

  my $qunksref = shift;

  my @filenames;
  my $beauty = '';          # The accumulating header string for this entry.
  my %non_unanimous_tags;   # Tags found in a proper subset of qunks
  my %unanimous_tags;       # Tags found in all qunks
  my %all_branches;         # Branches found in any qunk
  my $fbegun = 0;           # Did we begin printing filenames yet?

  my ($common_dir, $qunkrefs) =
    $self->_pretty_file_list(\(%unanimous_tags, %non_unanimous_tags, %all_branches), $qunksref);

  my @qunkrefs = @$qunkrefs;

  # Not XML output, so complexly compactify for chordate consumption.  At this
  # point we have enough global information about all the qunks to organize
  # them non-redundantly for output.

  if ($common_dir) {
    # Note that $common_dir still has its trailing slash
    $beauty .= "$common_dir: ";
  }

  if ($Show_Branches)
  {
    # For trailing revision numbers.
    my @brevisions;

    foreach my $branch (keys (%all_branches))
    {
      foreach my $qunkref (@qunkrefs)
      {
        if ((defined ($qunkref->branch))
            and ($qunkref->branch eq $branch))
        {
          if ($fbegun) {
            # kff todo: comma-delimited in XML too?  Sure.
            $beauty .= ", ";
          }
          else {
            $fbegun = 1;
          }
          my $fname = substr ($qunkref->filename, length ($common_dir));
          $beauty .= $fname;
          $qunkref->{'printed'} = 1;  # Just setting a mark bit, basically

          if ( $Show_Tags and defined $qunkref->tags ) {
            my @tags = grep ($non_unanimous_tags{$_}, @{$qunkref->tags});

            if (@tags) {
              $beauty .= " (tags: ";
              $beauty .= join (', ', @tags);
              $beauty .= ")";
            }
          }

          if ($Show_Revisions) {
            # Collect the revision numbers' last components, but don't
            # print them -- they'll get printed with the branch name
            # later.
            $qunkref->revision =~ /.+\.([\d]+)$/;
            push (@brevisions, $1);

            # todo: we're still collecting branch roots, but we're not
            # showing them anywhere.  If we do show them, it would be
            # nifty to just call them revision "0" on a the branch.
            # Yeah, that's the ticket.
          }
        }
      }
      $beauty .= " ($branch";
      if (@brevisions) {
        if ((scalar (@brevisions)) > 1) {
          $beauty .= ".[";
          $beauty .= (join (',', @brevisions));
          $beauty .= "]";
        }
        else {
          # Square brackets are spurious here, since there's no range to
          # encapsulate
          $beauty .= ".$brevisions[0]";
        }
      }
      $beauty .= ")";
    }
  }

  # Okay; any qunks that were done according to branch are taken care
  # of, and marked as printed.  Now print everyone else.

  my %fileinfo_printed;
  foreach my $qunkref (@qunkrefs)
  {
    next if (defined ($qunkref->{'printed'}));   # skip if already printed

    my $b = substr ($qunkref->filename, length ($common_dir));
    # todo: Shlomo's change was this:
    # $beauty .= substr ($qunkref->filename,
    #              (($common_dir eq "./") ? '' : length ($common_dir)));
    $qunkref->{'printed'} = 1;  # Set a mark bit.

    if ($Show_Revisions || $Show_Tags || $Show_Dead)
    {
      my $started_addendum = 0;

      if ($Show_Revisions) {
        $started_addendum = 1;
        $b .= " (";
        $b .= $qunkref->revision;
      }
      if ($Show_Dead && $qunkref->state =~ /dead/)
      {
        # Deliberately not using $started_addendum. Keeping it simple.
        $b .= "[DEAD]";
      }
      if ($Show_Tags && (defined $qunkref->tags)) {
        my @tags = grep ($non_unanimous_tags{$_}, @{$qunkref->tags});
        if ((scalar (@tags)) > 0) {
          if ($started_addendum) {
            $b .= ", ";
          }
          else {
            $b .= " (tags: ";
          }
          $b .= join (', ', @tags);
          $started_addendum = 1;
        }
      }
      if ($started_addendum) {
        $b .= ")";
      }
    }

    unless ( exists $fileinfo_printed{$b} ) {
      if ($fbegun) {
        $beauty .= ", ";
      } else {
        $fbegun = 1;
      }
      $beauty .= $b, $fileinfo_printed{$b} = 1;
    }
  }

  # Unanimous tags always come last.
  if ($Show_Tags && %unanimous_tags)
  {
    $beauty .= " (utags: ";
    $beauty .= join (', ', sort keys (%unanimous_tags));
    $beauty .= ")";
  }

  # todo: still have to take care of branch_roots?

  $beauty = "$beauty:";

  return $beauty;
}

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

sub output_tagdate {
  my $self = shift;
  my ($fh, $time, $tag) = @_;

  my $fdatetime = $self->fdatetime($time);
  print $fh "$fdatetime  tag $tag\n\n";
  return;
}

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

sub format_body {
  my $self = shift;
  my ($msg, $files, $qunklist) = @_;

  my $body;

  if ( $No_Wrap and ! $Summary ) {
    $msg = $self->preprocess_msg_text($msg);
    $files = $self->mywrap("\t", "\t  ", "* $files");
    $msg =~ s/\n(.+)/\n$Indent$1/g;
    unless ($After_Header eq " ") {
      $msg =~ s/^(.+)/$Indent$1/g;
    }
    if ( $Hide_Filenames ) {
      $body = $After_Header . $msg;
    } else {
      $body = $files . $After_Header . $msg;
    }
  } elsif ( $Summary ) {
    my ($filelist, $qunk);
    my (@DeletedQunks, @AddedQunks, @ChangedQunks);

    $msg = $self->preprocess_msg_text($msg);
    #
    #     Sort the files (qunks) according to the operation that was
    # performed.  Files which were added have no line change
    # indicator, whereas deleted files have state dead.
    #
    foreach $qunk ( @$qunklist ) {
      if ( "dead" eq $qunk->state) {
        push @DeletedQunks, $qunk;
      } elsif ( ! defined $qunk->lines ) {
        push @AddedQunks, $qunk;
      } else {
        push @ChangedQunks, $qunk;
      }
    }
    #
    #     The qunks list was  originally in tree search order.  Let's
    # get that back.  The lists, if they exist, will be reversed upon
    # processing.
    #

    #
    #     Now write the three sections onto $filelist
    #
    if ( @DeletedQunks ) {
      $filelist .= "\tDeleted:\n";
      foreach $qunk ( @DeletedQunks ) {
        $filelist .= "\t\t" . $qunk->filename;
        $filelist .= " (" . $qunk->revision . ")";
        $filelist .= "\n";
      }
      undef @DeletedQunks;
    }

    if ( @AddedQunks ) {
      $filelist .= "\tAdded:\n";
      foreach $qunk (@AddedQunks) {
        $filelist .= "\t\t" . $qunk->filename;
        $filelist .= " (" . $qunk->revision . ")";
        $filelist .= "\n";
      }
      undef @AddedQunks ;
    }

    if ( @ChangedQunks ) {
      $filelist .= "\tChanged:\n";
      foreach $qunk (@ChangedQunks) {
        $filelist .= "\t\t" . $qunk->filename;
        $filelist .= " (" . $qunk->revision . ")";
        $filelist .= ", \"" . $qunk->state . "\"";
        $filelist .= ", lines: " . $qunk->lines;
        $filelist .= "\n";
      }
      undef @ChangedQunks;
    }

    chomp $filelist;

    if ( $Hide_Filenames ) {
      $filelist = '';
    }

    $msg =~ s/\n(.*)/\n$Indent$1/g;
    unless ( $After_Header eq " " or $FSF_Style ) {
      $msg =~ s/^(.*)/$Indent$1/g;
    }

    unless ( $No_Wrap ) {
      if ( $FSF_Style ) {
        $msg = $self->wrap_log_entry($msg, '', 69, 69);
        chomp($msg);
        chomp($msg);
      } else {
        $msg = $self->mywrap('', $Indent, "$msg");
        $msg =~ s/[ \t]+\n/\n/g;
      }
    }

    $body = $filelist . $After_Header . $msg;
  } else {  # do wrapping, either FSF-style or regular
    my $latter_wrap = $No_Extra_Indent ? $Indent : "$Indent  ";

    if ( $FSF_Style ) {
      $files = $self->mywrap($Indent, $latter_wrap, "* $files");

      my $files_last_line_len = 0;
      if ( $After_Header eq " " ) {
        $files_last_line_len = $self->last_line_len($files);
        $files_last_line_len += 1;  # for $After_Header
      }

      $msg = $self->wrap_log_entry($msg, $latter_wrap, 69-$files_last_line_len, 69);
      $body = $files . $After_Header . $msg;
    } else {  # not FSF-style
      $msg = $self->preprocess_msg_text($msg);
      $body = $files . $After_Header . $msg;
      $body = $self->mywrap($Indent, $latter_wrap, "* $body");
      $body =~ s/[ \t]+\n/\n/g;
    }
  }

  return $body;
}

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

package CVS::Utils::ChangeLog::EntrySet::Output::XML;

use base qw( CVS::Utils::ChangeLog::EntrySet::Output );

use File::Basename qw( fileparse );

sub new {
  my $class = shift;
  my $self = $class->SUPER::new(@_);
}

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

sub header_line {
  my $self = shift;
  my ($time, $author, $lastdate) = @_;

  my $header_line = '';

  my $isoDate;

  my ($y, $m, $d, $H, $M, $S) = (gmtime($time))[5,4,3,2,1,0];

  # Ideally, this would honor $UTC_Times and use +HH:MM syntax
  $isoDate = sprintf("%04d-%02d-%02dT%02d:%02d:%02dZ",
                     $y + 1900, $m + 1, $d, $H, $M, $S);

  my (undef,$min,$hour,$mday,$mon,$year,$wday)
    = $UTC_Times ? gmtime($time) : localtime($time);

  my $date = $self->fdatetime($time);
  $wday = $self->wday($wday);

  $header_line =
    sprintf ("<date>%4u-%02u-%02u</date>\n${wday}<time>%02u:%02u</time>\n",
             $year+1900, $mon+1, $mday, $hour, $min);
  $header_line .= "<isoDate>$isoDate</isoDate>\n"
    unless $No_XML_ISO_Date;
  $header_line .= sprintf("<author>%s</author>\n" , $author);
}

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

sub wday {
  my $self = shift; my $class = ref $self;
  my ($wday) = @_;

  return '<weekday>' . $class->weekday_en($wday) . "</weekday>\n";
}

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

sub escape {
  my $self = shift;

  my $txt = shift;
  $txt =~ s/&/&amp;/g;
  $txt =~ s/</&lt;/g;
  $txt =~ s/>/&gt;/g;
  return $txt;
}

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

sub output_header {
  my $self = shift;
  my ($fh) = @_;

  my $encoding    =
    length $XML_Encoding ? qq'encoding="$XML_Encoding"' : '';
  my $version     = 'version="1.0"';
  my $declaration =
    sprintf '<?xml %s?>', join ' ', grep length, $version, $encoding;
  my $root        =
    $No_XML_Namespace ?
      '<changelog>'     :
        '<changelog xmlns="http://www.red-bean.com/xmlns/cvs2cl/">';
  print $fh "$declaration\n\n$root\n\n";
}

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

sub output_footer {
  my $self = shift;
  my ($fh) = @_;

  print $fh "</changelog>\n";
}

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

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

  $text = $self->SUPER::preprocess_msg_text($text);

  $text = $self->escape($text);
  chomp $text;
  $text = "<msg>${text}</msg>\n";

  return $text;
}

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

# Here we take a bunch of qunks and convert them into a printed
# summary that will include all the information the user asked for.
sub pretty_file_list {
  my $self = shift;
  my ($qunksref) = @_;

  my $beauty = '';          # The accumulating header string for this entry.
  my %non_unanimous_tags;   # Tags found in a proper subset of qunks
  my %unanimous_tags;       # Tags found in all qunks
  my %all_branches;         # Branches found in any qunk
  my $fbegun = 0;           # Did we begin printing filenames yet?