help2man.h2m.PL

   1 #!/usr/bin/perl
   2
   3 # Self extracting help2man.h2m script.
   4
   5 #   -q, --quiet            Suppress extraction message
   6 #   -s, --stdout           Extract to stdout
   7 #   -o, --output=FILE      Extract to FILE
   8 #   -l, --locale=STRING    Output file for locale STRING
   9 #   -m, --message-dir=DIR  Directory for message catalogs
  10
  11 # Copyright (C) 2012, 2013, 2014 Free Software Foundation, Inc.
  12
  13 # Copying and distribution of this file, with or without modification,
  14 # are permitted in any medium without royalty provided the copyright
  15 # notice and this notice are preserved.  This file is offered as-is,
  16 # without any warranty.
  17
  18 # Written by Brendan O'Dea <bod@debian.org>
  19
  20 use 5.008;
  21 use Config;
  22 use Getopt::Long;
  23 use POSIX qw(setlocale LC_ALL);
  24
  25 my %opts;
  26 die "Usage: $0 [--quiet] [--stdout|--output=FILE] [--locale=STRING] ",
  27     "[--message-dir=DIR]\n" unless GetOptions \%opts,
  28         qw(quiet stdout output=s locale=s message-dir=s) and !@ARGV;
  29
  30 my $DOMAIN = 'help2man';
  31 my $target = $0;
  32 my $tmp;
  33 if ($opts{stdout})
  34 {
  35     *OUT = *STDOUT;
  36     $opts{quiet} = 1;
  37 }
  38 else
  39 {
  40     if ($opts{output})
  41     {
  42         $target = $opts{output};
  43     }
  44     else
  45     {
  46         $target =~ s!.*/!!;
  47         $target =~ s/\.PL$// or die "$0: can't determine target name\n";
  48         if ($opts{locale})
  49         {
  50             $target =~ s/(\.[^.]*)$/.$opts{locale}$1/
  51               or $target =~ s/$/.$opts{locale}/;
  52         }
  53     }
  54
  55     $tmp = "$target.tmp$$";
  56     unlink $tmp       or die "$0: can't unlink $tmp ($!)\n" if -e $tmp;
  57     open OUT, ">$tmp" or die "$0: can't create $tmp ($!)\n";
  58 }
  59
  60 my $msg = "Extracting $target";
  61 $msg .= ' (with locale substitutions)' if $opts{locale};
  62 print $msg, "\n" unless $opts{quiet};
  63
  64 sub _;
  65 if ($opts{locale})
  66 {
  67     delete @ENV{qw(LANGUAGE LC_MESSAGES LANG)};
  68     setlocale LC_ALL, $ENV{LC_ALL} = $opts{locale};
  69
  70     require Locale::gettext;
  71     require I18N::Langinfo;
  72     require Encode;
  73     my $gettext = Locale::gettext->domain($DOMAIN);
  74     $gettext->dir($opts{'message-dir'}) if $opts{'message-dir'};
  75     my $encoding = I18N::Langinfo::langinfo(I18N::Langinfo::CODESET());
  76     *_ = sub { Encode::encode($encoding, $gettext->get($_[0])) }
  77 }
  78 else
  79 {
  80     *_ = sub { $_[0] }
  81 }
  82
  83 print OUT _('Include file for help2man man page'), "\n";
  84 print OUT "\n";
  85 print OUT '--locale=', $opts{locale} || 'C', "\n";
  86 print OUT "\n";
  87
  88 print OUT '[', _('NAME'), "]\n";
  89 print OUT _('help2man \- generate a simple manual page'), "\n";
  90 print OUT "\n";
  91
  92 print OUT '[', _('INCLUDE FILES'), "]\n";
  93 print OUT _(<<'EOT');
  94 Additional material may be included in the generated output with the
  95 .B \-\-include
  96 and
  97 .B \-\-opt\-include
  98 options.  The format is simple:
  99
 100     [section]
 101     text
 102
 103     /pattern/
 104     text
 105 EOT
 106 print OUT "\n";
 107
 108 print OUT _(<<'EOT');
 109 Blocks of verbatim *roff text are inserted into the output either at
 110 the start of the given
 111 .BI [ section ]
 112 (case insensitive), or after a paragraph matching
 113 .BI / pattern /\fR.
 114 EOT
 115 print OUT "\n";
 116
 117 print OUT _(<<'EOT');
 118 Patterns use the Perl regular expression syntax and may be followed by
 119 the
 120 .IR i ,
 121 .I s
 122 or
 123 .I m
 124 modifiers (see
 125 .BR perlre (1)).
 126 EOT
 127 print OUT "\n";
 128
 129 print OUT _(<<'EOT');
 130 Lines before the first section or pattern which begin with `\-' are
 131 processed as options.  Anything else is silently ignored and may be
 132 used for comments, RCS keywords and the like.
 133 EOT
 134 print OUT "\n";
 135
 136 print OUT _('The section output order (for those included) is:'), "\n";
 137 print OUT "\n";
 138 print OUT '    ', _('NAME'), "\n";
 139 print OUT '    ', _('SYNOPSIS'), "\n";
 140 print OUT '    ', _('DESCRIPTION'), "\n";
 141 print OUT '    ', _('OPTIONS'), "\n";
 142 print OUT '    ', _('ENVIRONMENT'), "\n";
 143 print OUT '    ', _('FILES'), "\n";
 144 print OUT '    ', _('EXAMPLES'), "\n";
 145 print OUT '    \fI', _('other'), "\\fR\n";
 146 print OUT '    ', _('AUTHOR'), "\n";
 147 print OUT '    ', _('REPORTING BUGS'), "\n";
 148 print OUT '    ', _('COPYRIGHT'), "\n";
 149 print OUT '    ', _('SEE ALSO'), "\n";
 150 print OUT "\n";
 151
 152 print OUT _(<<'EOT');
 153 Any
 154 .B [NAME]
 155 or
 156 .B [SYNOPSIS]
 157 sections appearing in the include file will replace what would have
 158 automatically been produced (although you can still override the
 159 former with
 160 .B --name
 161 if required).
 162 EOT
 163 print OUT "\n";
 164
 165 print OUT _(<<'EOT');
 166 Other sections are prepended to the automatically produced output for
 167 the standard sections given above, or included at
 168 .I other
 169 (above) in the order they were encountered in the include file.
 170 EOT
 171 print OUT "\n";
 172
 173 print OUT _(<<'EOT');
 174 Placement of the text within the section may be explicitly requested by using
 175 the syntax
 176 .RI [< section ],
 177 .RI [= section ]
 178 or
 179 .RI [> section ]
 180 to place the additional text before, in place of, or after the default
 181 output respectively.
 182 EOT
 183 print OUT "\n";
 184
 185 print OUT '[', _('AVAILABILITY'), "]\n";
 186 print OUT _('The latest version of this distribution is available on-line from:'), "\n";
 187 print OUT "\n";
 188 print OUT "    ftp://ftp.gnu.org/gnu/help2man/\n";
 189
 190 # Fix output file permissions
 191 unless ($opts{stdout})
 192 {
 193     close OUT;
 194     rename $tmp, $target or die "$0: can't rename $tmp to $target ($!)\n";
 195     chmod 0444, $target  or warn "$0: can't change mode of $target ($!)\n";
 196 }
 197
 198 exit 0;