lib-src/grep-changelog

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