2 # Lintian::Tag::Info -- interface to tag metadata
4 # Copyright (C) 1998 Christian Schwarz and Richard Braakman
5 # Copyright (C) 2009 Russ Allbery
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)
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
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/>.
20 package Maemian::Tag::Info;
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);
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
36 = 'http://manpages.debian.net/cgi-bin/man.cgi?query=NAME&sektion=SECTION';
38 # Stores the parsed tag information for all known tags. Loaded the first
39 # time new() is called.
42 # Stores the parsed manual reference data. Loaded the first time info()
48 Lintian::Tag::Info - Lintian interface to tag metadata
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', ' ');
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.
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.
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
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.
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");
94 unless ($tag->{tag}) {
95 fail("missing Tag field in $desc");
97 $tag->{info} = '' unless exists($tag->{info});
98 $INFO{$tag->{tag}} = $tag;
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.
107 my ($class, $tag) = @_;
108 croak('no tag specified') unless $tag;
109 _load_tag_data() unless %INFO;
111 my $self = $INFO{$tag};
112 bless($self, $class) unless ref($self) eq $class;
121 =head1 INSTANCE METHODS
125 =item description([FORMAT [, INDENT]])
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.
134 If INDENT is specified, the string INDENT is prepended to each line of the
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: $!");
153 next unless /^(.+?)::(.*?)::(.+?)::(.*?)$/;
154 my ($manual, $section, $title, $url) = split('::');
155 $MANUALS{$manual}{$section}{title} = $title;
156 $MANUALS{$manual}{$section}{url} = $url;
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}{''};
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;
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";
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>)];
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 {
199 for my $ref (split(/,\s*/, $field)) {
201 if ($ref =~ /^([\w-]+)\s+(.+)$/) {
202 $text = _manual_reference($1, $2);
203 } elsif ($ref =~ /^([\w_-]+)\((\d\w*)\)$/) {
204 my ($name, $section) = ($1, $2);
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>);
212 push (@refs, $text) if $text;
215 # Now build an English list of the results with appropriate commas and
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.';
227 # Returns the formatted tag 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");
236 # Build the tag description.
237 my $info = $self->{info};
238 $info =~ s/\n[ \t]/\n/g;
239 my @text = split_paragraphs($info);
241 push(@text, '', _format_reference($self->{ref}));
243 if ($self->{severity} and $self->{certainty}) {
244 my $severity = $self->{severity};
245 my $certainty = $self->{certainty};
246 push(@text, '', "Severity: $severity, Certainty: $certainty");
248 if ($self->{experimental}) {
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.');
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));
269 The following exceptions may be thrown:
273 =item no tag specified
275 The Lintian::Tag::Info::new constructor was called without passing a tag
278 =item unknown output format %s
280 An unknown output format was passed as the FORMAT argument of
281 description(). FORMAT must be either C<text> or C<html>.
285 The following fatal internal errors may be reported:
289 =item can't open %s: %s
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
295 =item missing Check-Script field in %s
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.
301 =item missing Tag field in %s
303 The specified check description file has a tag section that has no Tag
312 =item LINTIAN_ROOT/checks/*.desc
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.
317 =item LINTIAN_ROOT/data/output/manual-references
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.
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
341 Originally written by Russ Allbery <rra@debian.org> for Lintian.
352 # indent-tabs-mode: nil
353 # cperl-indent-level: 4
355 # vim: syntax=perl sw=4 sts=4 ts=4 et shiftround