1 # Hey emacs! This is a -*- Perl -*- script!
2 # Read_taginfo -- Perl utility function to read Lintian's tag information
4 # Copyright (C) 1998 Christian Schwarz and Richard Braakman
6 # This program is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 2 of the License, or
9 # (at your option) any later version.
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License
17 # along with this program. If not, you can find it on the World Wide
18 # Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
19 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
22 my $LINTIAN_ROOT = $ENV{'LINTIAN_ROOT'} || '/usr/share/lintian';
23 my $debug = $ENV{'LINTIAN_DEBUG'} || 0;
25 use lib "$ENV{'LINTIAN_ROOT'}/lib";
29 use vars qw(%url); # from the above
33 # define hash for manuals
35 'policy' => 'Policy Manual',
36 'devref' => 'Developers Reference',
42 # load information about checker scripts
48 if (defined $type && $type eq 'html') {
49 $dtml_convert = \&dtml_to_html;
51 $dtml_convert = \&dtml_to_text;
55 for my $f (<$LINTIAN_ROOT/checks/*.desc>) {
56 print "N: Reading checker description file $f ...\n" if $debug >= 2;
58 my @secs = read_dpkg_control($f);
59 $secs[0]->{'check-script'} or fail("error in description file $f: `Check-Script:' not defined");
61 for (my $i=1; $i<=$#secs; $i++) {
62 (my $tag = $secs[$i]->{'tag'}) or fail("error in description file $f: section $i does not have a `Tag:'");
64 my @foo = split_paragraphs($secs[$i]->{'info'});
65 if ($secs[$i]->{'ref'}) {
67 push(@foo,format_ref($secs[$i]->{'ref'}));
70 if ($secs[$i]->{'experimental'}) {
72 push(@foo,"Please note that this tag is marked Experimental, which "
73 . "means that the code that generates it is not as well tested "
74 . "as the rest of Lintian, and might still give surprising "
75 . "results. Feel free to ignore Experimental tags that do not "
76 . "seem to make sense, though of course bug reports are always "
80 $tag_info{$tag} = join("\n",&$dtml_convert(@foo));
89 my @foo = split(/\s*,\s*/o,$ref);
91 for ($u=0; $u<=$#foo; $u++) {
92 if ($foo[$u] =~ m,^\s*(policy|devref|fhs)\s*([\d\.]+)?\s*$,oi) {
93 my ($man,$sec) = ($1,$2);
95 $foo[$u] = $manual{lc $man};
97 if ($sec =~ m,^\d+$,o) {
98 $foo[$u] .= ", chapter $sec";
100 $foo[$u] .= ", section $sec";
103 if (exists $url{"$man-$sec"}) {
104 $foo[$u] = "<a href=\"$url{\"$man-$sec\"}\">$foo[$u]</a>";
105 } elsif (exists $url{$man}) {
106 $foo[$u] = "<a href=\"$url{$man}\">$foo[$u]</a>";
108 } elsif ($foo[$u] =~ m,\s*([\w_-]+\(\d+\w*\))\s*$,i) {
109 $foo[$u] = "the $foo[$u] manual page";
114 $ref = sprintf "Refer to %s, and %s for details.",join(', ',splice(@foo,0,$#foo)),@foo;
115 } elsif ($#foo+1 > 0) {
116 $ref = sprintf "Refer to %s for details.",join(' and ',@foo);