vcs.maemo.org Git - maemian/blob - lib/Maemian/Tag/Info.pm

   1 # -*- perl -*-
   2 # Lintian::Tag::Info -- interface to tag metadata
   3
   4 # Copyright (C) 1998 Christian Schwarz and Richard Braakman
   5 # Copyright (C) 2009 Russ Allbery
   6 #
   7 # This program is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by the Free
   9 # Software Foundation; either version 2 of the License, or (at your option)
  10 # any later version.
  11 #
  12 # This program is distributed in the hope that it will be useful, but WITHOUT
  13 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14 # FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
  15 # more details.
  16 #
  17 # You should have received a copy of the GNU General Public License along with
  18 # this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 package Maemian::Tag::Info;
  21
  22 use strict;
  23 use warnings;
  24
  25 use Carp qw(croak);
  26
  27 use Maemian::Output qw(debug_msg);
  28 use Text_utils qw(dtml_to_html dtml_to_text split_paragraphs wrap_paragraphs);
  29 use Util qw(fail read_dpkg_control);
  30
  31 # The URL to a web man page service.  NAME is replaced by the man page
  32 # name and SECTION with the section to form a valid URL.  This is used
  33 # when formatting references to manual pages into HTML to provide a link
  34 # to the manual page.
  35 our $MANURL
  36     = 'http://manpages.debian.net/cgi-bin/man.cgi?query=NAME&sektion=SECTION';
  37
  38 # Stores the parsed tag information for all known tags.  Loaded the first
  39 # time new() is called.
  40 our %INFO;
  41
  42 # Stores the parsed manual reference data.  Loaded the first time info()
  43 # is called.
  44 our %MANUALS;
  45
  46 =head1 NAME
  47
  48 Lintian::Tag::Info - Lintian interface to tag metadata
  49
  50 =head1 SYNOPSIS
  51
  52     my $tag = Lintian::Tag::Info->new('some-tag');
  53     print "Tag info is:\n";
  54     print $tag_info->description('text', '   ');
  55     print "\nTag info in HTML is:\n";
  56     print $tag_info->description('html', '   ');
  57
  58 =head1 DESCRIPTION
  59
  60 This module provides an interface to tag metadata as gleaned from the
  61 *.desc files describing the checks.  Currently, it is only used to format
  62 and return the tag description, but it provides a framework that can be
  63 used to retrieve other metadata about tags.
  64
  65 =head1 CLASS METHODS
  66
  67 =over 4
  68
  69 =item new(TAG)
  70
  71 Creates a new Lintian::Tag::Info object for the given TAG.  Returns undef
  72 if the tag is unknown and throws an exception if there is a parse error
  73 reading the check description files or if TAG is not specified.
  74
  75 The first time this method is called, all tag metadata will be loaded into
  76 a memory cache.  This information will be used to satisfy all subsequent
  77 Lintian::Tag::Info object creation, avoiding multiple file reads.  This
  78 however means that a running Lintian process will not notice changes to
  79 tag metadata on disk.
  80
  81 =cut
  82
  83 # Load all tag data into the %INFO hash.  Called by new() if %INFO is
  84 # empty and hence called the first time new() is called.
  85 sub _load_tag_data {
  86     my $root = $ENV{LINTIAN_ROOT} || '/usr/share/lintian';
  87     for my $desc (<$root/checks/*.desc>) {
  88         debug_msg(2, "Reading checker description file $desc ...");
  89         my ($header, @tags) = read_dpkg_control($desc);
  90         unless ($header->{'check-script'}) {
  91             fail("missing Check-Script field in $desc");
  92         }
  93         for my $tag (@tags) {
  94             unless ($tag->{tag}) {
  95                 fail("missing Tag field in $desc");
  96             }
  97             $tag->{info} = '' unless exists($tag->{info});
  98             $INFO{$tag->{tag}} = $tag;
  99         }
 100     }
 101 }
 102
 103 # Create a new object for the given tag.  We just use the hash created by
 104 # read_dpkg_control as the object, which means we slowly bless the objects
 105 # in %INFO as we return them.
 106 sub new {
 107     my ($class, $tag) = @_;
 108     croak('no tag specified') unless $tag;
 109     _load_tag_data() unless %INFO;
 110     if ($INFO{$tag}) {
 111         my $self = $INFO{$tag};
 112         bless($self, $class) unless ref($self) eq $class;
 113         return $self;
 114     } else {
 115         return;
 116     }
 117 }
 118
 119 =back
 120
 121 =head1 INSTANCE METHODS
 122
 123 =over 4
 124
 125 =item description([FORMAT [, INDENT]])
 126
 127 Returns the formatted description (the Info field) for a tag.  FORMAT must
 128 be either C<text> or C<html> and defaults to C<text> if no format is
 129 specified.  If C<text>, returns wrapped paragraphs formatted in plain text
 130 with a right margin matching the Text::Wrap default, preserving as
 131 verbatim paragraphs that begin with whitespace.  If C<html>, return
 132 paragraphs formatted in HTML.
 133
 134 If INDENT is specified, the string INDENT is prepended to each line of the
 135 formatted output.
 136
 137 =cut
 138
 139 # Load manual reference data into %MANUALS.  This information doesn't have
 140 # a single unique key and has multiple data values per key, so we don't
 141 # try to use the Lintian::Data interface.  Instead, we read a file
 142 # delimited by double colons.  We do use a path similar to Lintian::Data
 143 # to keep such files in the same general location.
 144 sub _load_manual_data {
 145     my $root = $ENV{LINTIAN_ROOT} || '/usr/share/lintian';
 146     open(REFS, '<', "$root/data/output/manual-references")
 147         or fail("can't open $root/data/output/manual-references: $!");
 148     local $_;
 149     while (<REFS>) {
 150         chomp;
 151         next if /^\#/;
 152         next if /^\s*$/;
 153         next unless /^(.+?)::(.*?)::(.+?)::(.*?)$/;
 154         my ($manual, $section, $title, $url) = split('::');
 155         $MANUALS{$manual}{$section}{title} = $title;
 156         $MANUALS{$manual}{$section}{url} = $url;
 157     }
 158     close REFS;
 159 }
 160
 161 # Format a reference to a manual in the HTML that Lintian uses internally
 162 # for tag descriptions and return the result.  Takes the name of the
 163 # manual and the name of the section.  Returns an empty string if the
 164 # argument isn't a known manual.
 165 sub _manual_reference {
 166     my ($manual, $section) = @_;
 167     _load_manual_data unless %MANUALS;
 168     return '' unless exists $MANUALS{$manual}{''};
 169
 170     # Start with the reference to the overall manual.
 171     my $title = $MANUALS{$manual}{''}{title};
 172     my $url   = $MANUALS{$manual}{''}{url};
 173     my $text  = $url ? qq(<a href="$url">$title</a>) : $title;
 174
 175     # Add the section information, if present, and a direct link to that
 176     # section of the manual where possible.
 177     if ($section and $section =~ /^[A-Z]+$/) {
 178         $text .= " appendix $section";
 179     } elsif ($section and $section =~ /^\d+$/) {
 180         $text .= " chapter $section";
 181     } elsif ($section and $section =~ /^[A-Z\d.]+$/) {
 182         $text .= " section $section";
 183     }
 184     if ($section and exists $MANUALS{$manual}{$section}) {
 185         my $title = $MANUALS{$manual}{$section}{title};
 186         my $url   = $MANUALS{$manual}{$section}{url};
 187         $text .= qq[ (<a href="$url">$title</a>)];
 188     }
 189
 190     return $text;
 191 }
 192
 193 # Format the contents of the Ref attribute of a tag.  Handles manual
 194 # references in the form <keyword> <section>, manpage references in the
 195 # form <manpage>(<section>), and URLs.
 196 sub _format_reference {
 197     my ($field) = @_;
 198     my @refs;
 199     for my $ref (split(/,\s*/, $field)) {
 200         my $text;
 201         if ($ref =~ /^([\w-]+)\s+(.+)$/) {
 202             $text = _manual_reference($1, $2);
 203         } elsif ($ref =~ /^([\w_-]+)\((\d\w*)\)$/) {
 204             my ($name, $section) = ($1, $2);
 205             my $url = $MANURL;
 206             $url =~ s/NAME/$name/g;
 207             $url =~ s/SECTION/$section/g;
 208             $text = qq(the <a href="$url">$ref</a> manual page);
 209         } elsif ($ref =~ m,^(ftp|https?)://,) {
 210             $text = qq(<a href="$ref">$ref</a>);
 211         }
 212         push (@refs, $text) if $text;
 213     }
 214
 215     # Now build an English list of the results with appropriate commas and
 216     # conjunctions.
 217     my $text = '';
 218     if ($#refs >= 2) {
 219         $text = join(', ', splice(@refs, 0, $#refs));
 220         $text = "Refer to $text, and @refs for details.";
 221     } elsif ($#refs >= 0) {
 222         $text = 'Refer to ' . join(' and ', @refs) . ' for details.';
 223     }
 224     return $text;
 225 }
 226
 227 # Returns the formatted tag description.
 228 sub description {
 229     my ($self, $format, $indent) = @_;
 230     $indent = '' unless defined($indent);
 231     $format = 'text' unless defined($format);
 232     if ($format ne 'text' and $format ne 'html') {
 233         croak("unknown output format $format");
 234     }
 235
 236     # Build the tag description.
 237     my $info = $self->{info};
 238     $info =~ s/\n[ \t]/\n/g;
 239     my @text = split_paragraphs($info);
 240     if ($self->{ref}) {
 241         push(@text, '', _format_reference($self->{ref}));
 242     }
 243     if ($self->{severity} and $self->{certainty}) {
 244         my $severity = $self->{severity};
 245         my $certainty = $self->{certainty};
 246         push(@text, '', "Severity: $severity, Certainty: $certainty");
 247     }
 248     if ($self->{experimental}) {
 249         push(@text, '',
 250              'This tag is marked experimental, which means that the code that'
 251              . ' generates it is not as well-tested as the rest of Lintian'
 252              . ' and might still give surprising results.  Feel free to'
 253              . ' ignore experimental tags that do not seem to make sense,'
 254              . ' though of course bug reports are always welcomed.');
 255     }
 256
 257     # Format and return the output.
 258     if ($format eq 'text') {
 259         return wrap_paragraphs($indent, dtml_to_text(@text));
 260     } elsif ($format eq 'html') {
 261         return wrap_paragraphs('HTML', $indent, dtml_to_html(@text));
 262     }
 263 }
 264
 265 =back
 266
 267 =head1 DIAGNOSTICS
 268
 269 The following exceptions may be thrown:
 270
 271 =over 4
 272
 273 =item no tag specified
 274
 275 The Lintian::Tag::Info::new constructor was called without passing a tag
 276 as an argument.
 277
 278 =item unknown output format %s
 279
 280 An unknown output format was passed as the FORMAT argument of
 281 description().  FORMAT must be either C<text> or C<html>.
 282
 283 =back
 284
 285 The following fatal internal errors may be reported:
 286
 287 =over 4
 288
 289 =item can't open %s: %s
 290
 291 The specified file, which should be part of the standard Lintian data
 292 files, could not be opened.  The file may be missing or have the wrong
 293 permissions.
 294
 295 =item missing Check-Script field in %s
 296
 297 The specified check description file has no Check-Script field in its
 298 header section.  This probably indicates the file doesn't exist or has
 299 some significant formatting error.
 300
 301 =item missing Tag field in %s
 302
 303 The specified check description file has a tag section that has no Tag
 304 field.
 305
 306 =back
 307
 308 =head1 FILES
 309
 310 =over 4
 311
 312 =item LINTIAN_ROOT/checks/*.desc
 313
 314 The tag description files, from which tag metadata is read.  All files
 315 matching this shell glob expression will be read looking for tag data.
 316
 317 =item LINTIAN_ROOT/data/output/manual-references
 318
 319 Information about manual references.  Each non-comment, non-empty line of
 320 this file contains four fields separated by C<::>.  The first field is the
 321 name of the manual, the second field is the section or empty for data
 322 about the whole manual, the third field is the title, and the fourth field
 323 is the URL.  The URL is optional.
 324
 325 =back
 326
 327 =head1 ENVIRONMENT
 328
 329 =over 4
 330
 331 =item LINTIAN_ROOT
 332
 333 This variable specifies Lintian's root directory.  It defaults to
 334 F</usr/share/lintian> if not set.  The B<lintian> program normally takes
 335 care of setting it.
 336
 337 =back
 338
 339 =head1 AUTHOR
 340
 341 Originally written by Russ Allbery <rra@debian.org> for Lintian.
 342
 343 =head1 SEE ALSO
 344
 345 lintian(1)
 346
 347 =cut
 348
 349 1;
 350
 351 # Local Variables:
 352 # indent-tabs-mode: nil
 353 # cperl-indent-level: 4
 354 # End:
 355 # vim: syntax=perl sw=4 sts=4 ts=4 et shiftround