help2man.h2m.PL

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