1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
#!/usr/bin/perl
# Combine generated html page with GNU boilerplate.
# Copyright (C) 2012, 2020 Free Software Foundation, Inc.
# Copying and distribution of this file, with or without modification,
# are permitted in any medium without royalty provided the copyright
# notice and this notice are preserved. This file is offered as-is,
# without any warranty.
# Written by Brendan O'Dea <bod@debian.org>
use strict;
use warnings;
use File::Temp;
use Getopt::Long;
my %opts;
die "Usage: $0 [--quiet] [--stdout]\n"
unless GetOptions \%opts, qw(quiet stdout) and !@ARGV;
undef $/;
# Fetch GNU boilerplate
my $boilerplate;
my $url = 'http://www.gnu.org/server/standards/boilerplate-source.html';
do {
open my $b, '-|', 'curl', '-sL', $url or die "curl: $!";
$boilerplate = <$b>;
($url) = $boilerplate =~ /<meta\s+http-equiv=["']?refresh["']?\s+
content=["']\d+;\s+url=["']?(http[^"'>]*)/xi;
} while $url;
for ($boilerplate)
{
s#\$Revision:\s+(\S+)\s+\$#$1#;
s#<!-- ~+ -->(?:\s+<!--.*?-->)*##s;
s#<title>Baz\s+(- GNU Project)#<title>help2man $1#s;
s#\bbug-baz\b#bug-help2man#g;
s#<h2>GNU\sBaz</h2>.*(</div><!--\s+for\s+id="content")#%body%$1#s;
}
my ($header, $footer) = split /%body%/, $boilerplate;
die "can't parse boilerplate" unless $footer;
# Generate manual from texinfo
my $texi_tmp = File::Temp->new();
system 'makeinfo', '--html', '--no-number-sections', '--no-headers',
'--no-split', '--output=' . $texi_tmp->filename, 'help2man.texi';
my $gnu_standards = "http://www.gnu.org/prep/standards/standards.html";
my $body = <$texi_tmp>;
for ($body)
{
s#^.*<body(?:\s[^>]*)?>##s;
s#</body>.*##s;
# Fixup references
s#<a\s+href="standards\.html#<a href="$gnu_standards#g;
s#<a\s+href="\*manpages\*\.html\#perlre"
#<a href="http://perldoc.perl.org/perlre.html"#xg;
# Drop heading sizes by one, as h1 is quite loud.
s#<(/?)h(\d)\b#"<${1}h" . ($2 + 1)#ge;
}
# Write output
my $target = $0;
my $tmp;
if ($opts{stdout})
{
*OUT = *STDOUT;
$opts{quiet} = 1;
}
else
{
$target =~ s!.*/!!;
$target =~ s/\.PL$// or die "$0: can't determine target name\n";
$tmp = "$target.tmp$$";
unlink $tmp or die "$0: can't unlink $tmp ($!)\n" if -e $tmp;
open OUT, ">$tmp" or die "$0: can't create $tmp ($!)\n";
}
print "Extracting $target (with GNU boilerplate)\n"
unless $opts{quiet};
print OUT $header, $body, $footer;
# Fix output file permissions
unless ($opts{stdout})
{
close OUT;
rename $tmp, $target or die "$0: can't rename $tmp to $target ($!)\n";
chmod 0444, $target or warn "$0: can't change mode of $target ($!)\n";
}
exit 0;
|
