help2man.html.PL

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