Adjust some perl & tcl related things in various scripts & utilities.
[dragonfly.git] / tools / tools / commitsdb / query_commit_db
CommitLineData
52b73b16 1#!/usr/pkg/bin/perl -w
984263bc
MD
2
3# $FreeBSD: src/tools/tools/commitsdb/query_commit_db,v 1.3.2.1 2002/08/12 13:37:46 joe Exp $
1de703da 4# $DragonFly: src/tools/tools/commitsdb/query_commit_db,v 1.2 2003/06/17 04:29:11 dillon Exp $
984263bc
MD
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
11use strict;
12use Digest::MD5 qw(md5_hex);
13
14my $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.
18my ($file, $revision, $genpatch) = (shift, shift, shift);
19
20# Find the checksum of the named revision.
21my %possible_files;
22open DB, "< $dbname" or die "$!\n";
23my $cksum;
24while (<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}
34close DB;
35
36# Handle the fall-out if the file/revision wasn't matched.
37unless ($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.
49my @results;
50open DB, "< $dbname" or die "$!\n";
51while (<DB>) {
52 chomp;
53 my ($name, $rev, $hash) = split;
54
55 next unless $hash eq $cksum;
56
57 push @results, "$name $rev";
58}
59close DB;
60
61# May as well show the log message if we're producing a patch
62print `cvs log -r$revision $file` if $genpatch;
63
64# Show the commits that match, and their patches if required.
65foreach 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#
78sub 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