1#! /usr/bin/perl
2
3# Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
4#               2005, 2006, 2007 Free Software Foundation, Inc.
5#
6# This file is part of GNU Emacs.
7#
8# GNU Emacs is free software; you can redistribute it and/or modify
9# it under the terms of the GNU General Public License as published by
10# the Free Software Foundation; either version 2, or (at your option)
11# any later version.
12#
13# GNU Emacs is distributed in the hope that it will be useful,
14# but WITHOUT ANY WARRANTY; without even the implied warranty of
15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16# GNU General Public License for more details.
17#
18# You should have received a copy of the GNU General Public License
19# along with GNU Emacs; see the file COPYING.  If not, write to the
20# Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21# Boston, MA 02110-1301, USA.
22
23
24# Extract entries from ChangeLogs matching specified criteria.
25# Optionally format the resulting output to a form suitable for RCS
26# logs, like they are used in Emacs, for example.  In this format,
27# author lines, leading spaces, and file names are removed.
28
29require 5;
30use strict;
31
32# Parse command line options.
33
34use vars qw($author $regexp $exclude $from_date $to_date
35            $rcs_log $with_date $version $help $reverse
36            @entries);
37
38use Getopt::Long;
39
40my $result;
41
42if (@ARGV == 0) {
43
44    # No arguments cannot posibly mean "show everything"!!
45    $result = 0;
46
47} else {
48
49    $result = GetOptions ("author=s" => \$author,
50                          "text=s"  => \$regexp,
51                          "exclude=s"  => \$exclude,
52                          "from-date=s" => \$from_date,
53                          "to-date=s" => \$to_date,
54                          "rcs-log" => \$rcs_log,
55                          "with-date" => \$with_date,
56                          "reverse!" => \$reverse,
57                          "version" => \$version,
58                          "help"    => \$help);
59
60    # If date options are specified, check that they have the format
61    # YYYY-MM-DD.
62
63    $result = 0 if $from_date && $from_date !~ /^\d\d\d\d-\d\d-\d\d$/;
64    $result = 0 if $to_date && $to_date !~ /^\d\d\d\d-\d\d-\d\d$/;
65}
66
67# Print usage information and exit when necessary.
68
69if ($result == 0 || $help) {
70    print <<USAGE;
71
72Usage: $0 [options] [CHANGELOG...]
73
74Print entries in ChangeLogs matching various criteria.
75Valid options are:
76
77  --author=AUTHOR         Match entries whose author line matches
78			  regular expression AUTHOR
79  --text=TEXT             Match entries whose text matches regular
80			  expression TEXT
81  --exclude=TEXT	  Exclude entries matching TEXT
82  --from-date=YYYY-MM-DD  Match entries not older than given date
83  --to-date=YYYY-MM-DD    Match entries not younger than given date
84  --rcs-log		  Format output suitable for RCS log entries
85  --with-date		  Print short date line in RCS log
86  --reverse               Show entries in reverse (chronological) order
87  --version		  Print version info
88  --help		  Print this help
89
90If no CHANGELOG is specified scan the files "ChangeLog" and
91"ChangeLog.N+" in the current directory.  Old-style dates in ChangeLogs
92are not recognized.
93USAGE
94    exit !$help;
95}
96
97# Print version info and exit if `--version' was specified.
98
99if ($version) {
100    print "0.3\n";
101    exit 0;
102}
103
104
105# Value is non-zero if HEADER matches according to command line
106# options specified, i.e. it matches $author, and its date is in
107# the range $from_date <= date <= $to_date.
108
109sub header_match_p {
110    my $header = shift;
111
112    return 0 unless $header;
113
114    # No match if AUTHOR-regexp specified and doesn't match.
115    return 0 if $author && $header !~ /$author/;
116
117    # Check that the date of the entry matches if date options
118    # `--from-date' and/or `--to-date' were specified .  Old-style
119    # dates in ChangeLogs are not recognized, and never match.
120    if ($from_date || $to_date) {
121	if ($header =~ /^(\d\d\d\d-\d\d-\d\d)/) {
122	    my $date = $1;
123	    return 0 if $from_date && $date lt $from_date;
124	    return 0 if $to_date && $date gt $to_date;
125	} else {
126	    # Don't bother recognizing old-style dates.
127	    return 0;
128	}
129    }
130
131    return 1;
132}
133
134
135# Value is non-zero if ENTRY matches the criteria specified on the
136# command line, i.e. it matches $regexp, and it doesn't match
137# $exclude.
138
139sub entry_match_p {
140    my $entry = shift;
141
142    return 0 unless $entry;
143
144    if ($regexp) {
145	return 1 if ($entry =~ /$regexp/
146		     && (!$exclude || $entry !~ $exclude));
147    } else {
148	return 1 if !$exclude || $entry !~ $exclude;
149    }
150
151    return 0;
152}
153
154
155# Print HEADER and/or ENTRY in a format suitable for what was
156# specified on the command line.  If $rcs_log is specified, author
157# lines are not printed, and leading spaces and file names are removed
158# from ChangeLog entries.
159
160sub print_log {
161    my ($header, $entry) = @_;
162    my $output = '';
163
164    if ($rcs_log) {
165	# Remove leading whitespace from entry.
166	$entry =~ s/^\s+//mg;
167	# Remove file name parts.
168	$entry =~ s/^\*.*\(/(/mg;
169	# Remove file name parts, 2.
170	$entry =~ s/^\*.*://mg;
171        if ($with_date) {
172	    $header =~ /(\d\d\d\d-\d\d-\d\d)/;
173	    $output = "!changelog-date $1\n";
174	}
175	$output .= $entry;
176    } else {
177	$output .= $header . $entry;
178    }
179
180    if ($reverse) {
181        push @entries, $output;
182    } else {
183        print $output;
184    }
185}
186
187# Scan LOG for matching entries, and print them to standard output.
188
189sub parse_changelog {
190    my $log = shift;
191    my $entry = undef;
192    my $header = undef;
193
194    @entries = () if $reverse;
195
196    # Open the ChangeLog.
197    open (IN, "< $log") || die "Cannot open $log: $!";
198
199    while (defined(my $line = <IN>)) {
200	if ($line =~ /^\S/) {
201	    # Line is an author-line.  Print previous entry if
202	    # it matches.
203	    print_log ($header, $entry)
204		if header_match_p ($header) && entry_match_p ($entry);
205
206	    $entry = "";
207  	    $header = $line;
208
209	    # Add empty lines below the header.
210	    while (defined($line = <IN>) && $line =~ /^\s*$/) {
211	        $header = "$header$line";
212	    }
213        }
214
215        last unless defined $line;
216
217	if ($line =~ /^\s*\*/) {
218	    # LINE is the first line of a ChangeLog entry.  Print
219	    # previous entry if it matches.
220	    print_log ($header, $entry)
221		if header_match_p ($header) && entry_match_p ($entry);
222	    $entry = $line;
223	} else {
224	    # Add LINE to the current entry.
225	    $entry = "$entry$line";
226	}
227    }
228
229    # Print last entry if it matches.
230    print_log ($header, $entry)
231	if header_match_p ($header) && entry_match_p ($entry);
232
233    close IN;
234
235    if ($reverse) {
236        for (my $entry = @entries; $entry; $entry--) {
237            print $entries[$entry-1];
238        }
239    }
240}
241
242
243# Main program.  Process ChangeLogs.
244
245# If files were specified on the command line, parse those files in the
246# order supplied by the user; otherwise parse default files ChangeLog and
247# ChangeLog.NNN according to $reverse.
248unless (@ARGV > 0) {
249    @ARGV = ("ChangeLog");
250
251    push @ARGV,
252      map {"ChangeLog.$_"}
253        sort {$b <=> $a}
254          map {/\.(\d+)$/; $1}
255            do {
256                opendir D, '.';
257                grep /^ChangeLog\.\d+$/, readdir D;
258            };
259
260    @ARGV = reverse @ARGV if $reverse;
261}
262
263while (defined (my $log = shift @ARGV)) {
264    parse_changelog ($log) if -f $log;
265}
266
267
268# arch-tag: 9e4f6749-e053-4bb7-b3ad-11947318418e
269# grep-changelog ends here.
270