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