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