1#! @PERL@ 2#+############################################################################## 3# 4# check_texinfo.pl: Extract texinfo commands from files 5# 6# Copyright (C) 2003, 2005 Patrice Dumas <dumas@centre-cired.fr> 7# & Derek Price <derek@ximbiot.com> 8# 9# This program is free software; you can redistribute it and/or modify 10# it under the terms of the GNU General Public License as published by 11# the Free Software Foundation; either version 2 of the License, or 12# (at your option) any later version. 13# 14# This program is distributed in the hope that it will be useful, 15# but WITHOUT ANY WARRANTY; without even the implied warranty of 16# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17# GNU General Public License for more details. 18# 19# You should have received a copy of the GNU General Public License 20# along with this program; if not, write to the Free Software 21# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 22# 02110-1301 USA 23# 24#-############################################################################## 25 26# This requires perl version 5 or higher 27require 5.0; 28 29 30 31use strict; 32use Getopt::Long; 33my $verbose; 34if (!GetOptions ("verbose" => \$verbose)) 35{ 36 die "usage: $0 [-v] file...\n"; 37} 38 39die "Need file to check\n" unless @ARGV > 0; 40 41my (%seen, %context); 42 43while (<>) 44{ 45 if (/\@(\*|\.|\:|\@|\{|\})/) 46 { 47 $seen{$&}++; 48 $context{$&} .= "> $_" if $verbose; 49 $_ = "$`XX$'"; 50 redo; 51 } 52 if (/\@(\w+)/) 53 { 54 my ($before, $match, $after); 55 ($before, $match, $after) = ($`, $&, $'); 56 if ($before =~ /\b[-\w]+$/ && $after =~ /^[-\w.]*\b/) 57 { # e-mail address 58 $seen{'e-mail address'}++; 59 $context{'e-mail address'} .= "> $_" if $verbose; 60 } 61 else 62 { 63 $seen{$match}++; 64 $context{$match} .= "> $_" if $verbose; 65 } 66 $match =~ s/^\@/X/; 67 $_ = "$before$match$after"; 68 redo; 69 } 70} 71 72foreach (sort(keys(%seen))) 73{ 74 if ($verbose) 75 { 76 print "$_\n"; 77 print $context{$_}; 78 } 79 else 80 { 81 print "$_ ($seen{$_})\n"; 82 } 83} 84 85 86