mirror of https://gitee.com/openkylin/lintian.git
116 lines
2.8 KiB
Perl
Executable File
116 lines
2.8 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
|
|
use v5.20;
|
|
use warnings;
|
|
use utf8;
|
|
|
|
use Const::Fast;
|
|
use IPC::Run3;
|
|
use Pod::Simple::HTMLBatch;
|
|
use Unicode::UTF8 qw(encode_utf8);
|
|
|
|
const my $EMPTY => q{};
|
|
|
|
my $destination = pop @ARGV;
|
|
my @input = @ARGV;
|
|
|
|
push @input, './lib', './doc/tutorial' unless @input;
|
|
$destination //= './doc/api.html';
|
|
my $lintian_version = guess_version();
|
|
|
|
if (!-d $destination) {
|
|
mkdir $destination
|
|
or die encode_utf8("could not create directory: $!");
|
|
}
|
|
|
|
my $convert = Pod::Simple::HTMLBatch->new;
|
|
$convert->html_render_class('My::Pod::Simple::XHTML');
|
|
$convert->contents_page_start(header());
|
|
# No footer - it contains a "current time" and is thus unreproducible
|
|
$convert->contents_page_end(q{});
|
|
$convert->css_flurry(0);
|
|
$convert->batch_convert(\@input, $destination);
|
|
|
|
print encode_utf8("HTML version available at $destination/index.html\n");
|
|
|
|
sub header {
|
|
|
|
return <<"EOF";
|
|
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
|
|
"http://www.w3.org/TR/html4/loose.dtd">
|
|
<html>
|
|
<head>
|
|
<title>Lintian (v$lintian_version) API doc</title>
|
|
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
|
</head>
|
|
<body class='contentspage'>
|
|
<h1>Lintian (v$lintian_version) API doc</h1>
|
|
<p><em>Note: </em>This API is not stable between releases.</p>
|
|
EOF
|
|
}
|
|
|
|
sub guess_version {
|
|
my $version;
|
|
my $dist;
|
|
|
|
my @dpkg_command = qw{dpkg-parsechangelog -c0};
|
|
my $output;
|
|
|
|
run3(\@dpkg_command, \undef, \$output);
|
|
my @lines = split(/\n/, $output);
|
|
|
|
while (defined(my $line = shift @lines)) {
|
|
$version = $1 if $line =~ m{\A Version: \s*+ (\S++) \s* \Z}xsm;
|
|
$dist = $1 if $line =~ m{\A Distribution: \s*+ (\S++) \s* \Z}xsm;
|
|
}
|
|
|
|
if ((not defined($dist) or $dist eq 'UNRELEASED') and -d '.git') {
|
|
|
|
delete $ENV{'GITDIR'};
|
|
|
|
# For unreleased versions, git describe is probably a better
|
|
# choice when available.
|
|
my @command = qw(git describe);
|
|
my $guess;
|
|
run3(\@command, \undef, \$guess);
|
|
|
|
chomp $guess;
|
|
$version = $guess
|
|
if $guess ne $EMPTY && $guess =~ m{\A \d+\. }xsm;
|
|
|
|
# Ignore git being missing (or even failing to work)
|
|
# - the version being incorrect for non-release cases is
|
|
# not a major issue.
|
|
}
|
|
return $version;
|
|
}
|
|
|
|
package My::Pod::Simple::XHTML;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use parent qw(Pod::Simple::XHTML);
|
|
|
|
# Skip the version tag (incl. a date) to get reproducible output
|
|
sub version_tag_comment {
|
|
return q{};
|
|
}
|
|
|
|
sub batch_mode_page_object_init {
|
|
my ($self) = @_;
|
|
|
|
$self->html_doctype(
|
|
'<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">'
|
|
);
|
|
|
|
$self->html_charset('UTF-8');
|
|
|
|
return;
|
|
}
|
|
|
|
# Local Variables:
|
|
# indent-tabs-mode: nil
|
|
# cperl-indent-level: 4
|
|
# End:
|
|
# vim: syntax=perl sw=4 sts=4 sr et
|