cvs2cl.pl

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

          # 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
# 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", ... ]
#   }

# 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, $symbolic_names) = @_;

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

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

  # Grab the branch, even though we may or may not need it:
  (my ($branch_prefix) = ($revision =~ /((?:\d+\.)+)\d+/));
  $branch_prefix =~ s/\.$//;
  $self{branch} = $branch_names->{$branch_prefix}
    if $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 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 main;

# Subrs ----------------------------------------------------------------------

sub delta_check {
  my ($time, $tags) = @_;

  # If we're in 'delta' mode, update the latest observed times for the
  # beginning and ending tags, and when we get around to printing output, we
  # will simply restrict ourselves to that timeframe...
  return
    unless $Delta_Mode;

  $Delta_StartTime = $time
    if $time > $Delta_StartTime and grep { $_ eq $Delta_From } @$tags;

  $Delta_EndTime = $time
    if $time > $Delta_EndTime and grep { $_ eq $Delta_To } @$tags;
}

sub run_ext {
  my ($cmd) = @_;
  $cmd = [$cmd]
    unless ref $cmd;
  local $" = ' ';
  my $out = qx"@$cmd 2>&1";
  my $rv  = $?;
  my ($sig, $core, $exit) = ($? & 127, $? & 128, $? >> 8);
  return $out, $exit, $sig, $core;
}

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

# If accumulating, grab the boundary date from pre-existing ChangeLog.
sub maybe_grab_accumulation_date {
  if (! $Cumulative || $Update) {
    return '';
  }

  # else

  open (LOG, "$Log_File_Name")
      or die ("trouble opening $Log_File_Name for reading ($!)");

  my $boundary_date;
  while (<LOG>)
  {
    if (/^(\d\d\d\d-\d\d-\d\d\s+\d\d:\d\d)/)
    {
      $boundary_date = "$1";
      last;
    }
  }

  close (LOG);

  # convert time from utc to local timezone if the ChangeLog has
  # dates/times in utc
  if ($UTC_Times && $boundary_date)
  {
    # convert the utc time to a time value
    my ($year,$mon,$mday,$hour,$min) = $boundary_date =~
      m#(\d+)-(\d+)-(\d+)\s+(\d+):(\d+)#;
    my $time = timegm(0,$min,$hour,$mday,$mon-1,$year-1900);
    # print the timevalue in the local timezone
    my ($ignore,$wday);
    ($ignore,$min,$hour,$mday,$mon,$year,$wday) = localtime($time);
    $boundary_date=sprintf ("%4u-%02u-%02u %02u:%02u",
                            $year+1900,$mon+1,$mday,$hour,$min);
  }

  return $boundary_date;
}

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

sub maybe_read_user_map_file {
  my %expansions;
  my $User_Map_Input;