pjs/webtools/bonsai/cvsblame.pl

826 строки
28 KiB
Perl
Executable File

#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
##############################################################################
#
# cvsblame.pl - Shamelessly adapted from Scott Furman's cvsblame script
# by Steve Lamm (slamm@netscape.com)
# - Annotate each line of a CVS file with its author,
# revision #, date, etc.
#
# Report problems to Steve Lamm (slamm@netscape.com)
#
##############################################################################
require 'timelocal.pl'; # timestamps
use Date::Format; # human-readable dates
$debug = 0;
# Extract base part of this script's name
($progname) = $0 =~ /([^\/]+)$/;
&cvsblame_init;
1;
sub cvsblame_init {
# Use default formatting options if none supplied
if (!$opt_A && !$opt_a && !$opt_d && !$opt_v) {
$opt_a = 1;
$opt_v = 1;
}
$time = time;
$SECS_PER_DAY = 60 * 60 * 24;
# Timestamp threshold at which annotations begin to occur, if -m option present.
$opt_m_timestamp = $time - $opt_m * $SECS_PER_DAY;
}
# Generic traversal of a CVS tree. Invoke callback function for
# individual directories that contain CVS files.
sub traverse_cvs_tree {
local ($dir, *callback, $nlink) = @_;
local ($dev, $ino, $mode, $subcount);
# Get $nlink for top-level directory
($dev, $ino, $mode, $nlink) = stat($dir) unless $nlink;
# Read directory
opendir(DIR, $dir) || die "Can't open $dir\n";
local(@filenames) = readdir(DIR);
closedir(DIR);
return if ! -d "$dir/CVS";
&callback($dir);
# This dir has subdirs
if ($nlink != 2) {
$subcount = $nlink - 2; # Number of subdirectories
for (@filenames) {
last if $subcount == 0;
next if $_ eq '.';
next if $_ eq '..';
next if $_ eq 'CVS';
$name = "$dir/$_";
($dev, $ino, $mode, $nlink) = lstat($name);
next unless -d _;
if (-x _ && -r _) {
print STDERR "$progname: Entering $name\n";
&traverse_cvs_tree($name, *callback, $nlink);
} else {
warn("Couldn't chdir to $name");
}
--$subcount;
}
}
}
# Consume one token from the already opened RCSFILE filehandle.
# Unescape string tokens, if necessary.
sub get_token {
# Erase all-whitespace lines.
while ($line_buffer =~ /^$/) {
die ("Unexpected EOF") if eof(RCSFILE);
$line_buffer = <RCSFILE>;
$line_buffer =~ s/^\s+//; # Erase leading whitespace
}
# A string of non-whitespace characters is a token ...
return $1 if ($line_buffer =~ s/^([^;@][^;\s]*)\s*//o);
# ...and so is a single semicolon ...
return ';' if ($line_buffer =~ s/^;\s*//o);
# ...or an RCS-encoded string that starts with an @ character.
$line_buffer =~ s/^@([^@]*)//o;
$token = $1;
# Detect single @ character used to close RCS-encoded string.
while ($line_buffer !~ /@/o || # Short-circuit optimization
$line_buffer !~ /([^@]|^)@([^@]|$)/o) {
$token .= $line_buffer;
die ("Unexpected EOF") if eof(RCSFILE);
$line_buffer = <RCSFILE>;
}
# Retain the remainder of the line after the terminating @ character.
$i = rindex($line_buffer, '@');
$token .= substr($line_buffer, 0, $i);
$line_buffer = substr($line_buffer, $i + 1);
# Undo escape-coding of @ characters.
$token =~ s/@@/@/og;
# Digest any extra blank lines.
while (($line_buffer =~ /^$/) && !eof(RCSFILE)) {
$line_buffer = <RCSFILE>;
}
return $token;
}
# Consume a token from RCS filehandle and ensure that it matches
# the given string constant.
sub match_token {
local ($match) = @_;
local ($token) = &get_token;
die "Unexpected parsing error in RCS file $rcs_pathname.\n",
"Expected token: $match, but saw: $token\n"
if ($token ne $match);
}
# Push RCS token back into the input buffer.
sub unget_token {
local ($token) = @_;
$line_buffer = $token . " " . $line_buffer;
}
# Parses "administrative" header of RCS files, setting these globals:
#
# $head_revision -- Revision for which cleartext is stored
# $principal_branch
# $file_description
# %revision_symbolic_name -- mapping from numerical revision # to symbolic tag
# %tag_revision -- mapping from symbolic tag to numerical revision #
#
sub parse_rcs_admin {
local ($token, $tag, $tag_name, $tag_revision);
# Undefine variables, because we may have already read another RCS file
undef %tag_revision;
undef %revision_symbolic_name;
while (1) {
# Read initial token at beginning of line
$token = &get_token(RCSFILE);
# We're done once we reach the description of the RCS tree
if ($token =~ /^\d/o) {
&unget_token($token);
return;
}
# print "token: $token\n";
if ($token eq "head") {
$head_revision = &get_token;
&get_token; # Eat semicolon
} elsif ($token eq "branch") {
$principal_branch = &get_token;
&get_token; # Eat semicolon
} elsif ($token eq "symbols") {
# Create an associate array that maps from tag name to
# revision number and vice-versa.
while (($tag = &get_token) ne ';') {
($tag_name, $tag_revision) = split(':', $tag);
$tag_revision{$tag_name} = $tag_revision;
$revision_symbolic_name{$tag_revision} = $tag_name;
}
} elsif ($token eq "comment") {
$file_description = &get_token;
&get_token; # Eat semicolon
# Ignore all these other fields - We don't care about them.
} elsif (($token eq "locks") ||
($token eq "strict") ||
($token eq "expand") ||
($token eq "access")) {
(1) while (&get_token ne ';');
} else {
warn ("Unexpected RCS token: $token\n");
}
}
die "Unexpected EOF";
}
# Construct associative arrays that represent the topology of the RCS tree
# and other arrays that contain info about individual revisions.
#
# The following associative arrays are created, keyed by revision number:
# %revision_date -- e.g. "96.02.23.00.21.52"
# %timestamp -- seconds since 12:00 AM, Jan 1, 1970 GMT
# %revision_author -- e.g. "tom"
# %revision_branches -- descendant branch revisions, separated by spaces,
# e.g. "1.21.4.1 1.21.2.6.1"
# %prev_revision -- revision number of previous *ancestor* in RCS tree.
# Traversal of this array occurs in the direction
# of the primordial (1.1) revision.
# %prev_delta -- revision number of previous revision which forms the
# basis for the edit commands in this revision.
# This causes the tree to be traversed towards the
# trunk when on a branch, and towards the latest trunk
# revision when on the trunk.
# %next_delta -- revision number of next "delta". Inverts %prev_delta.
#
# Also creates %last_revision, keyed by a branch revision number, which
# indicates the latest revision on a given branch,
# e.g. $last_revision{"1.2.8"} == 1.2.8.5
#
sub parse_rcs_tree {
local($revision, $date, $author, $branches, $next);
local($branch, $is_trunk_revision);
local($mon,$day,$hhmm,$year);
# Undefine variables, because we may have already read another RCS file
undef %timestamp;
undef %revision_age;
undef %revision_author;
undef %revision_branches;
undef %revision_ctime;
undef %revision_date;
undef %prev_revision;
undef %prev_delta;
undef %next_delta;
undef %last_revision;
while (1) {
$revision = &get_token;
# End of RCS tree description ?
if ($revision eq 'desc') {
&unget_token($revision);
return;
}
$is_trunk_revision = ($revision =~ /^[0-9]+\.[0-9]+$/);
$tag_revision{$revision} = $revision;
($branch) = $revision =~ /(.*)\.[0-9]+/o;
$last_revision{$branch} = $revision;
# Parse date
&match_token('date');
$date = &get_token;
$revision_date{$revision} = $date;
&match_token(';');
# Convert date into timestamp
@date_fields = reverse(split(/\./, $date));
$date_fields[4]--; # Month ranges from 0-11, not 1-12
$timestamp{$revision} = &timegm(@date_fields);
# Compute date string; Format it the way I like.
($mon, $day, $hhmm, $year) = split(/#/,
time2str("%b#%e#%H:%M#%Y",
$timestamp{$revision}));
$revision_ctime{$revision} = "$day $mon $year $hhmm";
# Save age
$revision_age{$revision} =
($time - $timestamp{$revision}) / $SECS_PER_DAY;
# Parse author
&match_token('author');
$author = &get_token;
$revision_author{$revision} = $author;
&match_token(';');
# Parse state;
&match_token('state');
(1) while (&get_token ne ';');
# Parse branches
&match_token('branches');
$branches = '';
while (($token = &get_token) ne ';') {
$prev_revision{$token} = $revision;
$prev_delta{$token} = $revision;
$branches .= "$token ";
}
$revision_branches{$revision} = $branches;
# Parse revision of next delta in chain
&match_token('next');
$next = '';
if (($token = &get_token) ne ';') {
$next = $token;
&get_token; # Eat semicolon
$next_delta{$revision} = $next;
$prev_delta{$next} = $revision;
if ($is_trunk_revision) {
$prev_revision{$revision} = $next;
} else {
$prev_revision{$next} = $revision;
}
}
if ($debug >= 3) {
print "<pre>revision = $revision\n";
print "date = $date\n";
print "author = $author\n";
print "branches = $branches\n";
print "next = $next</pre>\n\n";
}
}
}
sub parse_rcs_description {
&match_token('desc');
$rcs_file_description = &get_token;
}
# Construct associative arrays containing info about individual revisions.
#
# The following associative arrays are created, keyed by revision number:
# %revision_log -- log message
# %revision_deltatext -- Either the complete text of the revision,
# in the case of the head revision, or the
# encoded delta between this revision and another.
# The delta is either with respect to the successor
# revision if this revision is on the trunk or
# relative to its immediate predecessor if this
# revision is on a branch.
sub parse_rcs_deltatext {
undef %revision_log;
undef %revision_deltatext;
while (!eof(RCSFILE)) {
$revision = &get_token;
print "Reading delta for revision: $revision\n" if ($debug >= 3);
&match_token('log');
$revision_log{$revision} = &get_token;
&match_token('text');
$revision_deltatext{$revision} = &get_token;
}
}
# Reads and parses complete RCS file from already-opened RCSFILE descriptor.
sub parse_rcs_file {
print "Reading RCS admin...\n" if ($debug >= 2);
&parse_rcs_admin();
print "Reading RCS revision tree topology...\n" if ($debug >= 2);
&parse_rcs_tree();
if( $debug >= 3 ){
print "<pre>Keys:\n\n";
for $i (keys %tag_revision ){
$k = $tag_revision{$i};
print "yoyuo $i: $k\n";
}
print "</pre>\n";
}
&parse_rcs_description();
print "Reading RCS revision deltas...\n" if ($debug >= 2);
&parse_rcs_deltatext();
print "Done reading RCS file...\n" if ($debug >= 2);
}
# Map a tag to a numerical revision number. The tag can be a symbolic
# branch tag, a symbolic revision tag, or an ordinary numerical
# revision number.
sub map_tag_to_revision {
local($tag_or_revision) = @_;
local ($revision) = $tag_revision{$tag_or_revision};
# Is this a branch tag, e.g. xxx.yyy.0.zzz
if ($revision =~ /(.*)\.0\.([0-9]+)/o) {
$branch = $1 . '.' . $2;
# Return latest revision on the branch, if any.
return $last_revision{$branch} if (defined($last_revision{$branch}));
return $1; # No revisions on branch - return branch point
} else {
return $revision;
}
}
# Construct an ordered list of ancestor revisions to the given
# revision, starting with the immediate ancestor and going back
# to the primordial revision (1.1).
#
# Note: The generated path does not traverse the tree the same way
# that the individual revision deltas do. In particular,
# the path traverses the tree "backwards" on branches.
sub ancestor_revisions {
local ($revision) = @_;
local (@ancestors);
$revision = $prev_revision{$revision};
while ($revision) {
push(@ancestors, $revision);
$revision = $prev_revision{$revision};
}
return @ancestors;
}
# Extract the given revision from the digested RCS file.
# (Essentially the equivalent of cvs up -rXXX)
sub extract_revision {
local ($revision) = @_;
local (@path);
# Compute path through tree of revision deltas to most recent trunk revision
while ($revision) {
push(@path, $revision);
$revision = $prev_delta{$revision};
}
@path = reverse(@path);
shift @path; # Get rid of head revision
# Get complete contents of head revision
local (@text) = split(/^/, $revision_deltatext{$head_revision});
# Iterate, applying deltas to previous revision
foreach $revision (@path) {
$adjust = 0;
@diffs = split(/^/, $revision_deltatext{$revision});
local ($lines_added) = 0;
local ($lines_removed) = 0;
foreach $command (@diffs) {
if ($add_lines_remaining > 0) {
# Insertion lines from a prior "a" command.
splice(@text, $start_line + $adjust,
0, $command);
$add_lines_remaining--;
$adjust++;
} elsif ($command =~ /^d(\d+)\s(\d+)/) {
# "d" - Delete command
($start_line, $count) = ($1, $2);
splice(@text, $start_line + $adjust - 1, $count);
$adjust -= $count;
$lines_removed += $count;
} elsif ($command =~ /^a(\d+)\s(\d+)/) {
# "a" - Add command
($start_line, $count) = ($1, $2);
$add_lines_remaining = $count;
$lines_added += $lines_added;
} else {
die "Error parsing diff commands";
}
}
$lines_removed{$revision} += $lines_removed;
$lines_added{$revision} += $lines_added;
}
return @text;
}
sub parse_cvs_file {
local($rcs_pathname) = @_;
# Args in: $opt_rev - requested revision
# $opt_m - time since modified
# Args out: @revision_map
# $revision
# %timestamp
# (%revision_deltatext)
@revision_map = ();
CheckHidden($rcs_pathname);
die "$progname: error: This file appeared to be under CVS control, " .
"but the RCS file is inaccessible.\n(Couldn't open '$rcs_pathname')\n"
if !open (RCSFILE, "< $rcs_pathname");
&parse_rcs_file();
close(RCSFILE);
if (!defined($opt_rev) || $opt_rev eq '' || $opt_rev eq 'HEAD') {
# Explicitly specified topmost revision in tree
$revision = $head_revision;
} else {
# Symbolic tag or specific revision number specified.
$revision = &map_tag_to_revision($opt_rev);
die "$progname: error: -r: No such revision: $opt_rev\n"
if ($revision eq '');
}
# The primordial revision is not always 1.1! Go find it.
my $primordial = $revision;
while ($prev_revision{$primordial} != "") {
$primordial = $prev_revision{$primordial};
}
# Don't display file at all, if -m option is specified and no
# changes have been made in the specified file.
return if ($opt_m && $timestamp{$revision} < $opt_m_timestamp);
# Figure out how many lines were in the primordial, i.e. version 1.1,
# check-in by moving backward in time from the head revision to the
# first revision.
$line_count = split(/^/, $revision_deltatext{$head_revision});
for ($rev = $prev_revision{$head_revision}; $rev;
$rev = $prev_revision{$rev}) {
@diffs = split(/^/, $revision_deltatext{$rev});
foreach $command (@diffs) {
if ($skip > 0) {
# Skip insertion lines from a prior "a" command.
$skip--;
} elsif ($command =~ /^d(\d+)\s(\d+)/) {
# "d" - Delete command
($start_line, $count) = ($1, $2);
$line_count -= $count;
} elsif ($command =~ /^a(\d+)\s(\d+)/) {
# "a" - Add command
($start_line, $count) = ($1, $2);
$skip = $count;
$line_count += $count;
} else {
die "$progname: error: illegal RCS file $rcs_pathname\n",
" error appears in revision $rev\n";
}
}
}
# Now, play the delta edit commands *backwards* from the primordial
# revision forward, but rather than applying the deltas to the text of
# each revision, apply the changes to an array of revision numbers.
# This creates a "revision map" -- an array where each element
# represents a line of text in the given revision but contains only
# the revision number in which the line was introduced rather than
# the line text itself.
#
# Note: These are backward deltas for revisions on the trunk and
# forward deltas for branch revisions.
# Create initial revision map for primordial version.
while ($line_count--) {
push(@revision_map, $primordial);
}
@ancestors = &ancestor_revisions($revision);
unshift (@ancestors, $revision); #
pop @ancestors; # Remove "1.1"
$last_revision = $primordial;
foreach $revision (reverse @ancestors) {
$is_trunk_revision = ($revision =~ /^[0-9]+\.[0-9]+$/);
if ($is_trunk_revision) {
@diffs = split(/^/, $revision_deltatext{$last_revision});
# Revisions on the trunk specify deltas that transform a
# revision into an earlier revision, so invert the translation
# of the 'diff' commands.
foreach $command (@diffs) {
if ($skip > 0) {
$skip--;
} else {
if ($command =~ /^d(\d+)\s(\d+)$/) { # Delete command
($start_line, $count) = ($1, $2);
$#temp = -1;
while ($count--) {
push(@temp, $revision);
}
splice(@revision_map, $start_line - 1, 0, @temp);
} elsif ($command =~ /^a(\d+)\s(\d+)$/) { # Add command
($start_line, $count) = ($1, $2);
splice(@revision_map, $start_line, $count);
$skip = $count;
} else {
die "Error parsing diff commands";
}
}
}
} else {
# Revisions on a branch are arranged backwards from those on
# the trunk. They specify deltas that transform a revision
# into a later revision.
$adjust = 0;
@diffs = split(/^/, $revision_deltatext{$revision});
foreach $command (@diffs) {
if ($skip > 0) {
$skip--;
} else {
if ($command =~ /^d(\d+)\s(\d+)$/) { # Delete command
($start_line, $count) = ($1, $2);
splice(@revision_map, $start_line + $adjust - 1, $count);
$adjust -= $count;
} elsif ($command =~ /^a(\d+)\s(\d+)$/) { # Add command
($start_line, $count) = ($1, $2);
$skip = $count;
$#temp = -1;
while ($count--) {
push(@temp, $revision);
}
splice(@revision_map, $start_line + $adjust, 0, @temp);
$adjust += $skip;
} else {
die "Error parsing diff commands";
}
}
}
}
$last_revision = $revision;
}
$revision;
}
__END__
#
# The following are parts of the original cvsblame script that are not
# used for cvsblame.pl
#
# Read CVS/Entries and CVS/Repository files.
#
# Creates these associative arrays, keyed by the CVS file pathname
#
# %cvs_revision -- Revision # present in working directory
# %cvs_date
# %cvs_sticky_revision -- Sticky tag, if any
#
# Also, creates %cvs_files, keyed by the directory path, which contains
# a space-separated list of the files under CVS control in the directory
sub read_cvs_entries
{
local ($directory) = @_;
local ($filename, $rev, $date, $idunno, $sticky, $pathname);
$cvsdir = $directory . '/CVS';
CheckHidden($cvsdir);
return if (! -d $cvsdir);
return if !open(ENTRIES, "< $cvsdir/Entries");
while(<ENTRIES>) {
chop;
($filename, $rev, $date, $idunno, $sticky) = split("/", substr($_, 1));
($pathname) = $directory . "/" . $filename;
$cvs_revision{$pathname} = $rev;
$cvs_date{$pathname} = $date;
$cvs_sticky_revision{$pathname} = $sticky;
$cvs_files{$directory} .= "$filename\\";
}
close(ENTRIES);
return if !open(REPOSITORY, "< $cvsdir/Repository");
$repository = <REPOSITORY>;
chop($repository);
close(REPOSITORY);
$repository{$directory} = $repository;
}
# Given path to file in CVS working directory, compute path to RCS
# repository file. Cache that info for future use.
sub rcs_pathname {
($pathname) = @_;
if ($pathname =~ m@/@) {
($directory,$filename) = $pathname =~ m@(.*)/([^/]+)$@;
} else {
($directory,$filename) = ('.',$pathname);
$pathname = "./" . $pathname;
}
if (!defined($repository{$directory})) {
&read_cvs_entries($directory);
}
if (!defined($cvs_revision{$pathname})) {
die "$progname: error: File '$pathname' does not appear to be under" .
" CVS control.\n"
}
print STDERR "file: $filename\n" if $debug;
local ($rcs_path) = $repository{$directory} . '/' . $filename . ',v';
return $rcs_path if (-r $rcs_path);
# A file that exists only on the branch, not on the trunk, is found
# in the Attic subdir.
return $repository{$directory} . '/Attic/' . $filename . ',v';
}
sub show_annotated_cvs_file {
local($pathname) = @_;
local(@output) = ();
$revision = &parse_cvs_file($pathname);
@text = &extract_revision($revision);
die "$progname: Internal consistency error" if ($#text != $#revision_map);
# Set total width of line annotation.
# Warning: field widths here must match format strings below.
$annotation_width = 0;
$annotation_width += 8 if $opt_a; # author
$annotation_width += 7 if $opt_v; # revision
$annotation_width += 6 if $opt_A; # age
$annotation_width += 12 if $opt_d; # date
$blank_annotation = ' ' x $annotation_width;
if ($multiple_files_on_command_line) {
print "\n", "=" x (83 + $annotation_width);
print "\n$progname: Listing file: $pathname\n"
}
# Print each line of the revision, preceded by its annotation.
$line = 0;
foreach $revision (@revision_map) {
$text = $text[$line++];
$annotation = '';
# Annotate with revision author
$annotation .= sprintf("%-8s", $revision_author{$revision}) if $opt_a;
# Annotate with revision number
$annotation .= sprintf(" %-6s", $revision) if $opt_v;
# Date annotation
$annotation .= " $revision_ctime{$revision}" if $opt_d;
# Age annotation ?
$annotation .= sprintf(" (%3s)",
int($revision_age{$revision})) if $opt_A;
# -m (if-modified-since) annotion ?
if ($opt_m && ($timestamp{$revision} < $opt_m_timestamp)) {
$annotation = $blank_annotation;
}
# Suppress annotation of whitespace lines, if requested;
$annotation = $blank_annotation if $opt_w && ($text =~ /^\s*$/);
# printf "%4d ", $line if $opt_l;
# print "$annotation - $text";
push(@output, sprintf("%4d ", $line)) if $opt_l;
push(@output, "$annotation - $text");
}
@output;
}
sub usage {
die
"$progname: usage: [options] [file|dir]...\n",
" Options:\n",
" -r <revision> Specify CVS revision of file to display\n",
" <revision> can be any of:\n",
" + numeric tag, e.g. 1.23,\n",
" + symbolic branch or revision tag, e.g. CHEDDAR,\n",
" + HEAD keyword (most recent revision on trunk)\n",
" -a Annotate lines with author (username)\n",
" -A Annotate lines with age, in days\n",
" -v Annotate lines with revision number\n",
" -d Annotate lines with date, in local time zone\n",
" -l Annotate lines with line number\n",
" -w Don't annotate all-whitespace lines\n",
" -m <# days> Only annotate lines modified within last <# days>\n",
" -h Print help (this message)\n\n",
" (-a -v assumed, if none of -a, -v, -A, -d supplied)\n"
;
}
&usage if (!&Getopts('r:m:Aadhlvw'));
&usage if ($opt_h); # help option
$multiple_files_on_command_line = 1 if ($#ARGV != 0);
&cvsblame_init;
sub annotate_cvs_directory
{
local($dir) = @_;
&read_cvs_entries($dir);
foreach $file (split(/\\/, $cvs_files{$dir})) {
&show_annotated_cvs_file("$dir/$file");
}
}
# No files on command-line ? Use current directory.
push(@ARGV, '.') if ($#ARGV == -1);
# Iterate over files/directories on command-line
while ($#ARGV >= 0) {
$pathname = shift @ARGV;
# Is it a directory ?
if (-d $pathname) {
&traverse_cvs_tree($pathname, *annotate_cvs_directory);
# No, it must be a file.
} else {
&show_annotated_cvs_file($pathname);
}
}