Adjust some perl & tcl related things in various scripts & utilities.
[dragonfly.git] / tools / tools / commitsdb / make_commit_db
CommitLineData
52b73b16 1#!/usr/pkg/bin/perl -w
984263bc 2
05dd972c 3# $FreeBSD: src/tools/tools/commitsdb/make_commit_db,v 1.2 2002/10/17 16:29:26 joe Exp $
10b70345 4# $DragonFly: src/tools/tools/commitsdb/make_commit_db,v 1.5 2006/07/12 21:40:49 swildner Exp $
984263bc
MD
5
6# This script walks the tree from the current directory
7# and spits out a database generated by md5'ing the cvs log
8# messages of each revision of every file in the tree.
9
10use strict;
11use Digest::MD5 qw(md5_hex);
12
13my $dbname = "commitsdb";
14open DB, "> $dbname" or die "$!\n";
15
16# Extract all the logs for the current directory.
17my @dirs = ".";
18while (@dirs) {
19 my $dir = shift @dirs;
20 my %logs;
21
22 opendir DIR, $dir or die $!;
05dd972c
SW
23 foreach my $f (grep { /[^\.]/ } readdir DIR) {
24 my $filename = "$dir/$f";
984263bc
MD
25 if (-f $filename) {
26 my %loghash = parse_log_message($filename);
27 next unless %loghash;
28
29 $logs{$filename} = {%loghash};
05dd972c
SW
30 } elsif (-d $filename) {
31 next if $filename =~ /\/CVS$/;
32 push @dirs, $filename;
984263bc
MD
33 }
34 }
35 close DIR;
36
05dd972c 37 # Produce a database of the commits
984263bc
MD
38 foreach my $f (keys %logs) {
39 my $file = $logs{$f};
40 foreach my $rev (keys %$file) {
41 my $hash = $$file{$rev};
42
43 print DB "$f $rev $hash\n";
44 }
45 }
46
47 print "\r" . " " x 30 . "\r$dir";
48}
49print "\n";
50
51close DB;
52
53
54
55##################################################
56# Run a cvs log on a file and return a parse entry.
57##################################################
58sub parse_log_message {
59 my $file = shift;
60
61 # Get a log of the file.
05dd972c 62 open LOG, "cvs -R log $file 2>/dev/null |" or die $!;
984263bc
MD
63 my @log = <LOG>;
64 my $log = join "", @log;
65 close LOG;
66
67 # Split the log into revisions.
10b70345 68 my @entries = split /(?<=\n)-{28}\n(?=revision\s)/, $log;
984263bc
MD
69
70 # Throw away the first entry.
71 shift @entries;
72
73 # Record the hash of the message against the revision.
74 my %loghash = ();
75 foreach my $e (@entries) {
76 # Get the revision number
10b70345 77 $e =~ s/^revision\s+(\S+)(\s+locked\s+by:\s+\w+;)?\n//s;
984263bc
MD
78 my $rev = $1;
79
80 # Strip off any other headers.
05dd972c
SW
81 my $user;
82 while ($e =~ s/^(date|branches):([^\n]*)\n//sg) {
83 my $sub = $2;
84 $user = $1 if $sub =~ /author: (.*?);/;
984263bc
MD
85 };
86
87 my $hash = string_to_hash($e);
05dd972c 88 $loghash{$rev} = "$user:$hash";
984263bc
MD
89 }
90
91 return %loghash;
92}
93
94
95##################################################
96# Convert a log message into an md5 checksum.
97##################################################
98sub string_to_hash {
99 my $logmsg = shift;
100
101 return md5_hex($logmsg);
102}
103
104
105
106#end