Adjust some perl & tcl related things in various scripts & utilities.
[dragonfly.git] / tools / tools / commitsdb / query_commit_db
1 #!/usr/pkg/bin/perl -w
2
3 # $FreeBSD: src/tools/tools/commitsdb/query_commit_db,v 1.3.2.1 2002/08/12 13:37:46 joe Exp $
4 # $DragonFly: src/tools/tools/commitsdb/query_commit_db,v 1.2 2003/06/17 04:29:11 dillon Exp $
5
6 # This script takes a filename and revision number as arguments
7 # and spits out a list of other files and their revisions that share
8 # the same log message.  This is done by referring to the database
9 # previously written by running make_commit_db.
10
11 use strict;
12 use Digest::MD5 qw(md5_hex);
13
14 my $dbname = "commitsdb";
15
16 # Take the filename and revision number from the command line.
17 # Also take a flag to say whether to generate a patch or not.
18 my ($file, $revision, $genpatch) = (shift, shift, shift);
19
20 # Find the checksum of the named revision.
21 my %possible_files;
22 open DB, "< $dbname" or die "$!\n";
23 my $cksum;
24 while (<DB>) {
25         chomp;
26         my ($name, $rev, $hash) = split;
27         $name =~ s/^\.\///g;
28
29         $possible_files{$name} = 1 if $file !~ /\// && $name =~ /^.*\/$file/;
30
31         next unless $name eq $file and $rev eq $revision;
32         $cksum = $hash;
33 }
34 close DB;
35
36 # Handle the fall-out if the file/revision wasn't matched.
37 unless ($cksum) {
38         if (%possible_files) {
39                 print "Couldn't find the file. Maybe you meant:\n";
40                 foreach (sort keys %possible_files) {
41                         print "\t$_\n";
42                 }
43         }
44         die "Can't find $file rev $revision in database\n";
45 }
46
47
48 # Look for similar revisions.
49 my @results;
50 open DB, "< $dbname" or die "$!\n";
51 while (<DB>) {
52         chomp;
53         my ($name, $rev, $hash) = split;
54
55         next unless $hash eq $cksum;
56
57         push @results, "$name $rev";
58 }
59 close DB;
60
61 # May as well show the log message if we're producing a patch
62 print `cvs log -r$revision $file` if $genpatch;
63
64 # Show the commits that match, and their patches if required.
65 foreach my $r (sort @results) {
66         print "$r\n";
67         next unless $genpatch;
68
69         my ($name, $rev) = split /\s/, $r, 2;
70         my $prevrev = previous_revision($rev);
71         print `cvs diff -u -r$prevrev -r$rev $name`;
72         print "\n\n";
73 }
74
75 #
76 # Return the previous revision number.
77 #
78 sub previous_revision {
79         my $rev = shift;
80
81         $rev =~ /(?:(.*)\.)?([^\.]+)\.([^\.]+)$/;
82         my ($base, $r1, $r2) = ($1, $2, $3);
83
84         my $prevrev = "";
85         if ($r2 == 1) {
86                 $prevrev = $base;
87         } else {
88                 $prevrev = "$base." if $base;
89                 $prevrev .= "$r1." . ($r2 - 1);
90         }
91         return $prevrev;
92 }
93
94 #end