1#! /usr/bin/perl 2 3# Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 4# 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 23require 5; 24use Getopt::Long; 25 26my $USAGE = <<ENDUSAGE; 27Remove \@tindex lines from files that were already present in previous 28versions. 29 30Usage: $0 [--old=EXT] FILE... 31 $0 --help 32 $0 --version 33 34 --help display this help and exit 35 --version print version and exit 36 --old=DIR find old files in DIR 37 38The script performs two passes. In the first pass, Texinfo files from 39DIR are scanned for \@tindex lines, and identifiers in them are 40recorded. In a second pass, Texinfo files in the current directory 41are scanned, and \@tindex lines for identifiers that were recorded in 42the first pass are removed. Old file contents are saved in files 43with extension ".orig". A list of modified files and removed \@tindex 44identifiers is printed to stdout at the end. 45ENDUSAGE 46 47sub fatal { 48 print STDERR "$0: ", @_, ".\n"; 49 exit 1; 50} 51 52my $help = 0; 53my $version = 0; 54my $old; 55 56my $rc = GetOptions ('help' => \$help, 'version' => \$version, 57 'old=s' => \$old); 58if ($version) { 59 print "0.1\n"; 60 exit 0; 61} elsif (!$rc || !$old || @ARGV) { 62 print $USAGE; 63 exit 1; 64} elsif ($help) { 65 print $USAGE; 66 exit 0; 67} 68 69# Fill the hash %tindex with associations VAR -> COUNT where 70# the keys VAR are identifiers mentioned in @tindex lines in the older 71# files to process and COUNT is the number of times they are seen in 72# the files. 73 74my %tindex; 75my %removed; 76my @old_files = glob "$old/*.texi"; 77my @new_files = glob "*.texi"; 78fatal ("No Texinfo files found in `$old'") unless @old_files; 79fatal ("No Texinfo files found in current directory") unless @new_files; 80 81print "Scanning old files for \@tindex lines\n"; 82foreach $file (@old_files) { 83 open (IN, "<$file") or fatal "Cannot open $file: $!"; 84 while (<IN>) { 85 ++$tindex{$1} if /^\s*\@tindex\s+(\S+)/; 86 } 87 close IN; 88} 89 90# Process current files and remove those @tindex lines which we 91# know were already present in the files scanned above. 92 93print "Removing old \@tindex lines\n"; 94foreach $file (@new_files) { 95 my $modified = 0; 96 my $contents = ""; 97 98 open (IN, "< $file") or fatal "Cannot open $file.orig for reading: $!"; 99 while (<IN>) { 100 if (/^\s*\@tindex\s+(\S+)/ && $tindex{$1}) { 101 ++$removed{$1}; 102 $modified = 1; 103 } else { 104 $contents = $contents . $_; 105 } 106 } 107 108 close IN; 109 110 if ($modified) { 111 print " $file\n"; 112 system ("cp $file $file.orig") == 0 or fatal "Cannot backup $file: $!"; 113 open (OUT, ">$file") or fatal "Cannot open $file for writing: $!"; 114 print OUT $contents; 115 close OUT; 116 } 117} 118 119# Print a list of identifiers removed. 120 121print "Removed \@tindex commands for:\n"; 122my $key; 123foreach $key (keys %removed) { 124 print " $key\n"; 125} 126 127# arch-tag: f8460df6-6bef-4c98-8555-e2c63a88b0fa 128