vcs.maemo.org Git - maemian/blob - nokia-lintian/lib/Read_taginfo.pm

   1 # Hey emacs! This is a -*- Perl -*- script!
   2 # Read_taginfo -- Perl utility function to read Lintian's tag information
   3
   4 # Copyright (C) 1998 Christian Schwarz and Richard Braakman
   5 #
   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.
  10 #
  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.
  15 #
  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,
  20 # MA 02110-1301, USA.
  21
  22 my $LINTIAN_ROOT = $ENV{'LINTIAN_ROOT'} || '/usr/share/lintian';
  23 my $debug = $ENV{'LINTIAN_DEBUG'} || 0;
  24
  25 use lib "$ENV{'LINTIAN_ROOT'}/lib";
  26 use Util;
  27 use Text_utils;
  28 use Manual_refs;
  29 use vars qw(%url); # from the above
  30
  31 use strict;
  32
  33 # define hash for manuals
  34 my %manual = (
  35               'policy' => 'Policy Manual',
  36               'devref' => 'Developers Reference',
  37               'fhs' => 'FHS',
  38              );
  39
  40 srand;
  41
  42 # load information about checker scripts
  43 sub read_tag_info {
  44     my ($type) = @_;
  45
  46     my $dtml_convert;
  47     my %tag_info;
  48     if (defined $type && $type eq 'html') {
  49         $dtml_convert = \&dtml_to_html;
  50     } else {
  51         $dtml_convert = \&dtml_to_text;
  52     }
  53
  54  #   $debug = 2;
  55     for my $f (<$LINTIAN_ROOT/checks/*.desc>) {
  56         print "N: Reading checker description file $f ...\n" if $debug >= 2;
  57
  58         my @secs = read_dpkg_control($f);
  59         $secs[0]->{'check-script'} or fail("error in description file $f: `Check-Script:' not defined");
  60
  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:'");
  63
  64             my @foo = split_paragraphs($secs[$i]->{'info'});
  65             if ($secs[$i]->{'ref'}) {
  66                 push(@foo,"");
  67                 push(@foo,format_ref($secs[$i]->{'ref'}));
  68             }
  69
  70             if ($secs[$i]->{'experimental'}) {
  71                 push(@foo,"");
  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 "
  77                      . "welcomed.");
  78             }
  79
  80             $tag_info{$tag} = join("\n",&$dtml_convert(@foo));
  81         }
  82     }
  83     return \%tag_info;
  84 }
  85
  86 sub format_ref {
  87     my ($ref) = @_;
  88
  89     my @foo = split(/\s*,\s*/o,$ref);
  90     my $u;
  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);
  94
  95             $foo[$u] = $manual{lc $man};
  96
  97             if ($sec =~ m,^\d+$,o) {
  98                 $foo[$u] .= ", chapter $sec";
  99             } elsif ($sec) {
 100                 $foo[$u] .= ", section $sec";
 101             }
 102
 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>";
 107             }
 108         } elsif ($foo[$u] =~ m,\s*([\w_-]+\(\d+\w*\))\s*$,i) {
 109             $foo[$u] = "the $foo[$u] manual page";
 110         }
 111     }
 112
 113     if ($#foo+1 > 2) {
 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);
 117     }
 118
 119     return $ref;
 120 }
 121
 122 1;