~ubuntu-dev/ubuntu/lucid/quilt/lucid-201002101907

#!@PERL@ -w

#  This script is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License version 2 as
#  published by the Free Software Foundation.
#
#  See the COPYING and AUTHORS files for more details.

# Generate a dot-style graph of dependencies between patches.

use Getopt::Long;
use FileHandle;
use strict;

# Constants
my $short_edge_style = "color=grey";
my $close_node_style = "color=grey";
my $highlighted_node_style = "style=bold";

# Command line arguments
my $help = 0;
my $use_patcher = 0;		# Assume patcher format for metadata
my $short_edge_thresh = 0;	# threshold for coloring as "short", 0 = disable
my $long_edge_thresh = 0;	# threshold for coloring as "long",0 = disable
my $edge_labels;		# label all edges with filenames
my $short_edge_labels;		# label short edges with filenames
my $long_edge_labels;		# label long edges with filenames
my $edge_length_labels;		# distance between patches as edge labels
my $node_numbers;		# include sequence numbers
my $show_isolated_nodes;	# also include isolated nodes
my $reduce;			# remove transitive edges
my $filter_patchnames;		# filter for compacting filenames
my $selected_patch;		# only include patches related on this patch
my $selected_distance = -1;	# infinity
my @highlight_patches;		# a list of patches to highlight
my $lines;			# check ranges with this number of context
				# lines.

unless (GetOptions(
	"h|help"		=> \$help,
	"patcher"		=> \$use_patcher,
	"short-edge=i"		=> \$short_edge_thresh,
	"long-edge=i"		=> \$long_edge_thresh,
	"edge-files"		=> \$edge_labels,
	"short-edge-files"	=> \$short_edge_labels,
	"long-edge-files"	=> \$long_edge_labels,
	"edge-length"		=> \$edge_length_labels,
	"node-numbers"		=> \$node_numbers,
	"isolated"		=> \$show_isolated_nodes,
	"reduce"		=> \$reduce,
	"filter-patchnames=s"	=> \$filter_patchnames,
	"select-patch=s"	=> \$selected_patch,
	"select-distance=i"	=> \$selected_distance,
	"highlight=s"		=> \@highlight_patches,
	"lines=i"		=> \$lines) && !$help) {
    my $basename = $0;
    $basename =~ s:.*/::;
    my $fd = $help ? *STDOUT : *STDERR;
    print $fd <<EOF;
SYNOPSIS: $basename [-h] [--patcher] [--short-edge=num] [--long-edge=num]
	  [--short-edge-files] [--long-edge-files] [--edge-length]
	  [--node-numbers] [--isolated] [--reduce] [--filter-patchnames=filter]
	  [--select-patch=patch] [--select-distance=num] [--highlight=patch]
	  [--lines=num]

--patcher
	Assume patch manager is Holger Schurig's patcher script instead
	of the default quilt.

--short-edge=num, --long-edge=num
	Define the maximum edge length of short edges, and minimum edge
	length of long edges. Short edges are de-emphasized, and long
	edges are emphasized. The default is to treat all edges equally.

-edge-files, --short-edge-files, --long-edge-files
	Include conflicting filenames on all edges, short edges, or long
	edges.

--edge-length
	Use the edge lengths as edge labels. Cannot be used together with
	filename labels.

--node-numbers
	Include the sequence numbers of patches in the patch series in
	node labels.

--isolated
	Do not suppress isolated nodes.

--reduce
	Remove transitive edges.

--filter-patchnames=filter
	Define a filter command for transforming patch names into node
	labels. The filter is passed each patch name on a separate line,
	and must return the edge label for each patch on a separate line
	(example: sed -e 's/^prefix//').

--select-patch=patch
	Reduce the graph to nodes that depend on the specified patch,
	and nodes that the specified patch depends on (recursively).

--select-distance=num
	Limit the depth of recusion for --select-patch. The default is
	to recurse exhaustively.

--highlight=patch
	Highlight the specified patch. This option can be specified more
	than once.

--lines=num
	Check the ranges of lines that the patches modify for computing
	dependencies. Include up to num lines of context.
EOF
    exit $help ? 0 : 1;
}

my @nodes;

sub next_patch_for_file($$)
{
    my ($n, $file) = @_;

    for (my $i = $n + 1; $i < @nodes; $i++) {
	return $i
	    if (exists $nodes[$i]{files}{$file});
    }
    return undef;
}

# Compute the ranges of lines that a patch modifies: The patch should
# have no context lines. The return value is a list of pairs of line
# numbers, alternatingly marking the start and end of a modification.
sub ranges($) {
    my ($fd) = @_;
    my (@left, @right);
    while (<$fd>) {
	if (/^\@\@ -(\d+)(?:,(\d+)?) \+(\d+)(?:,(\d+)?) \@\@/) {
	    push @left,  ($3, $3 + $4);
	    push @right, ($1, $1 + $2);
	}
    }
    return [ [ @left ], [ @right ] ];
}

sub backup_file_name($$) {
    my ($patch, $file) = @_;

    if ($use_patcher) {
	return $file . "~" . $patch;
    } else {
	return $ENV{QUILT_PC} . "/" . $patch . "/" . $file;
    }
}

# Compute the lists of lines that a patch changes in a file.
sub compute_ranges($$) {
    my ($n, $file) = @_;
    my $file1 = backup_file_name($nodes[$n]{file}, $file);
    my $file2;
    my $n2 = next_patch_for_file($n, $file);
    if (defined $n2) {
	$file2 = backup_file_name($nodes[$n2]{file}, $file);
    } else {
	$file2 = $file;
    }

    #print STDERR "diff -NU$lines \"$file1\" \"$file2\"\n";
    if (-z $file1) {
	$file1="/dev/null";
	return [[], []]
	    if (-z $file2);
    } else {
	$file2="/dev/null"
	    if (-z $file2);
    }
    my $fd = new FileHandle("diff -NU$lines \"$file1\" \"$file2\" |");
    my $ranges = ranges($fd);
    $fd->close();
    return $ranges;
}

sub is_a_conflict($$$) {
    my ($from, $to, $filename) = @_;

    $nodes[$from]{files}{$filename} = compute_ranges($from, $filename)
	unless @{$nodes[$from]{files}{$filename}};
    $nodes[$to]{files}{$filename} = compute_ranges($to, $filename)
	unless @{$nodes[$to]{files}{$filename}};

    my @a = @{$nodes[$from]{files}{$filename}[1]};
    my @b = @{$nodes[$to  ]{files}{$filename}[0]};

    while (@a && @b) {
	if ($a[0] < $b[0]) {
	    return 1 if @b % 2;
	    shift @a;
	} elsif ($a[0] > $b[0]) {
	    return 1 if @a % 2;
	    shift @b;
	} else {
	    return 1 if (@a % 2) == (@b % 2);
	    shift @a;
	    shift @b;
	}
    }
    return 0;
}

# Fetch the list of patches (all of them must be applied)
my @patches;
if (@ARGV) {
	if (@ARGV == 1 && $ARGV[0] eq "-") {
		@patches = map { chomp ; $_ } <STDIN>;
	} else {
		@patches = @ARGV;
	}
} elsif ($use_patcher) {
	my $fh = new FileHandle("< .patches/applied")
		or die ".patches/applied: $!\n";
	@patches = map { chomp; $_ } <$fh>;
	$fh->close();
} else {
	my $fh = new FileHandle("< $ENV{QUILT_PC}/applied-patches")
		or die ".$ENV{QUILT_PC}/applied-patches: $!\n";
	@patches = map { chomp; $_ } <$fh>;
	$fh->close();
}

# Fetch the list of files
my $n = 0;
foreach my $patch (@patches) {
	my @files;
	if ($use_patcher) {
		my $fh = new FileHandle("< .patches/$patch.files")
			or die ".patches/$patch.files: $!\n";
		@files = map { chomp; $_ } <$fh>;
		$fh->close();
	} else {
		if (! -d "$ENV{QUILT_PC}/$patch") {
			print STDERR "$ENV{QUILT_PC}/$patch does not exist; skipping\n";
			next;
		}
		@files = split(/\n/, `cd $ENV{QUILT_PC}/$patch ; find -type f ! -name .timestamp`);
		@files = map { s:\./::; $_ } @files;
	}
	push @nodes, {number=>$n++, name=>$patch, file=>$patch,
		files=>{ map {$_ => []} @files } };
}

my %used_nodes;		# nodes to which at least one edge is attached

# If a patch is selected, limit the graph to nodes that depend on this patch,
# and nodes that are dependent on this patch.
if ($selected_patch) {
    for ($n = 0; $n < @nodes; $n++) {
	last if $nodes[$n]{file} eq $selected_patch;
    }
    die "Patch $selected_patch not included\n"
	if ($n == @nodes);

    $used_nodes{$n} = 1;
    my $selected_node = $nodes[$n];
    push @{$selected_node->{attrs}}, $highlighted_node_style;

    my %sel;
    map { $sel{$_} = 1 } keys %{$selected_node->{files}};
    foreach my $node (@nodes) {
	foreach my $file (keys %{$node->{files}}) {
	    unless (exists $sel{$file}) {
		delete $node->{files}{$file};
	    }
	}
    }
}

# Optionally highlight a list of patches
foreach my $patch (@highlight_patches) {
    for ($n = 0; $n < @nodes; $n++) {
	last if $nodes[$n]{file} eq $patch;
    }
    die "Patch $patch not included\n"
	if ($n == @nodes);

    my $node = $nodes[$n];
    push @{$node->{attrs}}, $highlighted_node_style;
    $node->{colorized} = 1;
}

# If a patchname filter is selected, pipe all patchnames through
# it.
if ($filter_patchnames) {
    local *PIPE;
    my $pid = open(PIPE, "- |");  # fork a child to read from
    die "fork: $!\n"
    	unless defined $pid;
    unless ($pid) {  # child
	# open a second pipe to the actual filter
	open(PIPE, "| $filter_patchnames")
	    or die "\`$filter_patchnames': $!\n";
	map { print PIPE "$_\n" } @patches;
	close(PIPE);
	exit;
    } else { # parent
	$n = 0;
	foreach my $name (<PIPE>) {
	    last unless $n < @nodes;
	    chomp $name;
	    if ($name eq "") {
		delete $nodes[$n++]{name};
	    } else {
		$nodes[$n++]{name} = $name;
	    }
	}
	close(PIPE)
	    or die "patchname filter failed.\n";
	die "patchname filter returned too few lines\n"
	    if $n != @nodes;
    }
}

my %files_seen;		# remember the last patch that touched each file
my %edges;

foreach my $node (@nodes) {
    my $number = $node->{number};
    foreach my $file (keys %{$node->{files}}) {
	if (exists $files_seen{$file}) {
	    my $patches = $files_seen{$file};
	    my $patch;
	    # Optionally look at the line ranges the patches touch
	    if (defined $lines) {
		for (my $n = $#$patches; $n >= 0; $n--) {
		    if (is_a_conflict($number, $patches->[$n], $file)) {
			$patch = $patches->[$n];
			last;
		    }
		}
	    } else {
		$patch = $patches->[$#$patches];
	    }
	    if (defined $patch) {
		push @{$edges{"$number:$patch"}{names}}, $file;
		$used_nodes{$number} = 1;
		$used_nodes{$patch} = 1;
	    }
	}
	push @{$files_seen{$file}}, $number;
    }
}

# Create adjacency lists
foreach my $node (@nodes) {
    @{$node->{to}} = ();
    @{$node->{from}} = ();
}
foreach my $key (keys %edges) {
    my ($from, $to) = split /:/, $key;
    push @{$nodes[$from]{to}}, $to;
    push @{$nodes[$to]{from}}, $from;
}

# Colorize nodes that are close to each other
foreach my $node (@nodes) {
    if (!exists $node->{colorized} && !exists $used_nodes{$node->{number}}) {
	$node->{colorized} = 1;
	push @{$node->{attrs}}, $close_node_style;
    }
}

# Colorize short and long edges
foreach my $node (@nodes) {
    my $close = 1;
    foreach my $node2 (map {$nodes[$_]} @{$node->{to}}) {
	if (abs($node2->{number} - $node->{number}) > $short_edge_thresh) {
	    $close = 0
	}
    }
    foreach my $node2 (map {$nodes[$_]} @{$node->{from}}) {
	if (abs($node2->{number} - $node->{number}) > $short_edge_thresh) {
	    $close = 0
	}
    }
    if (!exists $node->{colorized} && $close) {
	$node->{colorized} = 1;
	push @{$node->{attrs}}, $close_node_style;
    }
}

# Add node labels
foreach my $node (@nodes) {
    my @label = ();
    push @label, $node->{number} + 1
	if ($node_numbers);
    push @label, $node->{name}
	if exists $node->{name};
    push @{$node->{attrs}}, "label=\"" . join(": ", @label) . "\"";
}

# Add edge labels
foreach my $key (keys %edges) {
    my ($from, $to) = split /:/, $key;
    if ($edge_length_labels) {
	push @{$edges{$key}->{attrs}}, "label=\"" . abs($to - $from) . "\""
	    if abs($to - $from) > 1;
    } elsif (abs($to - $from) < $short_edge_thresh) {
	push @{$edges{$key}->{attrs}}, $short_edge_style;
	if ($edge_labels || $short_edge_labels) {
	    push @{$edges{$key}->{attrs}},
		"label=\"" . join("\\n", @{$edges{$key}{names}}) . "\"";
	}
    } else {
	if ($long_edge_thresh && abs($to - $from) > $long_edge_thresh) {
	    push @{$edges{$key}->{attrs}}, "style=bold";
	    if ($edge_labels || $long_edge_labels) {
		push @{$edges{$key}->{attrs}},
		    "label=\"" . join("\\n", @{$edges{$key}{names}}) . "\"";
	    }
	} else {
	    if ($edge_labels) {
		push @{$edges{$key}->{attrs}},
		    "label=\"" . join("\\n", @{$edges{$key}{names}}) . "\"";
	    }
	}
    }
    # Compute a pseudo edge length so that neato works acceptably.
    push @{$edges{$key}{attrs}}, "len=\"" .
    	sprintf("%.2f", log(abs($to - $from) + 3)) . "\"";
}

#foreach my $node (@nodes) {
#    push @{$node->{attrs}}, "shape=box";
#}

# Open output file / pipe
my $out;
if ($reduce) {
    $out = new FileHandle("| tred")
	or die "tred: $!\n";
} else {
    $out = new FileHandle("> /dev/stdout")
	or die "$!\n";
}

# Write graph
print $out "digraph dependencies {\n";
#print "\tsize=\"11,8\"\n";
foreach my $node (@nodes) {
    next unless $show_isolated_nodes || exists $used_nodes{$node->{number}};
    print $out "\tn$node->{number}";
    if (exists $node->{attrs}) {
	print $out " [" .
	      join(",", @{$node->{attrs}}) . "]";
    }
    print $out ";\n";
}

sub w($) {
    my @n = split /:/, shift;
    return $n[0] * 10000 + $n[1];
}
foreach my $key (sort { w($a) <=> w($b) } keys %edges) {
    my ($from, $to) = split /:/, $key;
    print $out "\tn$to -> n$from";
    if (exists $edges{$key}{attrs}) {
	print $out " [" . join(",", @{$edges{$key}{attrs}}) . "]";
    }
    print $out ";\n";
}
print $out "}\n";