X-Git-Url: http://vcs.maemo.org/git/?a=blobdiff_plain;f=nokia-lintian%2Flib%2FRead_taginfo.pm;fp=nokia-lintian%2Flib%2FRead_taginfo.pm;h=cd00db9c9332fb2d12c37c9bd8fb8890e1a3a1dd;hb=1975b83207a518d59ef6b04c7c16233cb353ca86;hp=0000000000000000000000000000000000000000;hpb=208f636c44e0ec2b53c70aaed2399d8e9cf0e741;p=maemian

diff --git a/nokia-lintian/lib/Read_taginfo.pm b/nokia-lintian/lib/Read_taginfo.pm
new file mode 100644
index 0000000..cd00db9
--- /dev/null
+++ b/nokia-lintian/lib/Read_taginfo.pm
@@ -0,0 +1,122 @@
+# Hey emacs! This is a -*- Perl -*- script!
+# Read_taginfo -- Perl utility function to read Lintian's tag information
+
+# Copyright (C) 1998 Christian Schwarz and Richard Braakman
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+my $LINTIAN_ROOT = $ENV{'LINTIAN_ROOT'} || '/usr/share/lintian';
+my $debug = $ENV{'LINTIAN_DEBUG'} || 0;
+
+use lib "$ENV{'LINTIAN_ROOT'}/lib";
+use Util;
+use Text_utils;
+use Manual_refs;
+use vars qw(%url); # from the above
+
+use strict;
+
+# define hash for manuals
+my %manual = (
+	      'policy' => 'Policy Manual',
+	      'devref' => 'Developers Reference',
+	      'fhs' => 'FHS',
+	     );
+
+srand;
+
+# load information about checker scripts
+sub read_tag_info {
+    my ($type) = @_;
+
+    my $dtml_convert;
+    my %tag_info;
+    if (defined $type && $type eq 'html') {
+	$dtml_convert = \&dtml_to_html;
+    } else {
+	$dtml_convert = \&dtml_to_text;
+    }
+
+ #   $debug = 2;
+    for my $f (<$LINTIAN_ROOT/checks/*.desc>) {
+	print "N: Reading checker description file $f ...\n" if $debug >= 2;
+
+	my @secs = read_dpkg_control($f);
+	$secs[0]->{'check-script'} or fail("error in description file $f: `Check-Script:' not defined");
+
+	for (my $i=1; $i<=$#secs; $i++) {
+	    (my $tag = $secs[$i]->{'tag'}) or fail("error in description file $f: section $i does not have a `Tag:'");
+
+	    my @foo = split_paragraphs($secs[$i]->{'info'});
+	    if ($secs[$i]->{'ref'}) {
+		push(@foo,"");
+		push(@foo,format_ref($secs[$i]->{'ref'}));
+	    }
+
+	    if ($secs[$i]->{'experimental'}) {
+		push(@foo,"");
+		push(@foo,"Please note that this tag is marked Experimental, which "
+		     . "means that the code that generates it is not as well tested "
+		     . "as the rest of Lintian, and might still give surprising "
+		     . "results.  Feel free to ignore Experimental tags that do not "
+		     . "seem to make sense, though of course bug reports are always "
+		     . "welcomed.");
+	    }
+
+	    $tag_info{$tag} = join("\n",&$dtml_convert(@foo));
+	}
+    }
+    return \%tag_info;
+}
+
+sub format_ref {
+    my ($ref) = @_;
+
+    my @foo = split(/\s*,\s*/o,$ref);
+    my $u;
+    for ($u=0; $u<=$#foo; $u++) {
+	if ($foo[$u] =~ m,^\s*(policy|devref|fhs)\s*([\d\.]+)?\s*$,oi) {
+	    my ($man,$sec) = ($1,$2);
+
+	    $foo[$u] = $manual{lc $man};
+
+	    if ($sec =~ m,^\d+$,o) {
+		$foo[$u] .= ", chapter $sec";
+	    } elsif ($sec) {
+		$foo[$u] .= ", section $sec";
+	    }
+
+	    if (exists $url{"$man-$sec"}) {
+		$foo[$u] = "<a href=\"$url{\"$man-$sec\"}\">$foo[$u]</a>";
+	    } elsif (exists $url{$man}) {
+		$foo[$u] = "<a href=\"$url{$man}\">$foo[$u]</a>";
+	    }
+	} elsif ($foo[$u] =~ m,\s*([\w_-]+\(\d+\w*\))\s*$,i) {
+	    $foo[$u] = "the $foo[$u] manual page";
+	}
+    }
+	
+    if ($#foo+1 > 2) {
+	$ref = sprintf "Refer to %s, and %s for details.",join(', ',splice(@foo,0,$#foo)),@foo;
+    } elsif ($#foo+1 > 0) {
+	$ref = sprintf "Refer to %s for details.",join(' and ',@foo);
+    }
+
+    return $ref;
+}
+
+1;