git.gag.com Git - debian/tar/blob - debian/tarman

   1 #
   2 # tarman - make tar man page from src/tar.c
   3 # some text cribbed from debian tar man page
   4 #
   5
   6 use strict;
   7 use POSIX qw(strftime);
   8
   9 my $t = $ENV{'BUILD_DATE'} // strftime("%a, %d %b %Y %H:%M:%S %z", localtime(time));
  10 my $datestr = substr($t,8,3)." ".substr($t,5,2).", ".substr($t,12,4);
  11
  12 @ARGV=qw(src/tar.c);
  13 my $mode;
  14 my @operations;
  15 my $lastoperation;
  16 my @options;
  17 my @formats;
  18 my @short;
  19 my $examples;
  20 my $saw_format;
  21 my @env_vars;
  22 while (<>) {
  23         my $nflag = 0;
  24         chomp;
  25 # print "$mode: $_\n";
  26         if (/getenv.*"/) {
  27                 next if defined($mode);
  28                 my @c1 = split('"');
  29                 if ($#c1 > 0) {
  30                         push @env_vars, $c1[1];
  31                 }
  32         }
  33         if (/Main operation mode:/) {
  34                 $mode = 1;
  35                 next;
  36         }
  37         if (/Operation modifiers:/) {
  38                 $mode = 2;
  39                 next;
  40         }
  41         if (/Examples:/) {
  42                 $mode = 3;
  43                 next;
  44         }
  45         if (/define GRID/) {
  46                 $mode = 2;
  47         }
  48         if (/undef GRID/) {
  49                 undef $lastoperation;
  50                 undef $mode;
  51                 next;
  52         }
  53         if ($mode == 1 || $mode == 2) {
  54                 if (/{"/) {     # }
  55                         my @j = split(',');
  56                         my @c1 = split('"', $j[0]);
  57                         if (/OPTION_ALIAS/) {
  58                                 next unless defined($lastoperation);
  59                                 push @{$$lastoperation{'alias'} }, $c1[1];
  60                                 next;
  61                         }
  62                         my %newhash = ();
  63                         $lastoperation = \%newhash;
  64                         my $name = $c1[1];
  65                         if ($name =~ /^  /) {
  66                                 $name =~ s/^  */format=/;
  67                                 push @formats, $lastoperation;
  68                         } elsif ($mode == 1) {
  69                                 push @operations, $lastoperation;
  70                         } else {
  71                                 push @options, $lastoperation;
  72                         }
  73                         $newhash{'name'} = $name;
  74                         if ($mode == 2 && $name eq 'format') {
  75                                 $saw_format = $lastoperation;
  76                         }
  77                         my @c2 = split("'", $j[1]);
  78                         if ($#c2 > 0) {
  79                                 $newhash{'short'} = $c2[1];
  80                                 push @short, $c2[1] if ($mode == 1);
  81                         }
  82                         if ($j[2] =~ /N_/) {
  83                                 $nflag = 1;
  84                         }
  85                 }
  86                 if (/N_/) {
  87                         next unless defined($lastoperation);
  88                         my $nrest = $_;
  89                         $nrest =~ s/.*N_//;
  90                         my @c3 = split('"', $nrest);
  91                         if ($#c3 > 0) {
  92                                 if ($nflag) {
  93                                         $$lastoperation{'operand'} .= $c3[1];
  94                                 } else {
  95                                         $$lastoperation{'description'} .= $c3[1];
  96                                 }
  97                         }
  98                         if (!$nflag && !/\}/) {
  99                                 while (<>) {
 100                                         my @extended_desc = split('"', $_);
 101                                         $$lastoperation{'description'} .= $extended_desc[1];
 102                                         if (/\}/) {
 103                                                 last;
 104                                         }
 105                                 }
 106                         }
 107                 }
 108         }
 109         if ($mode == 3 ) {
 110                 my $j = $_;
 111                 $j =~ s/\\n.*//;
 112                 my ($c1, $c2) = split('#', $j, 2);
 113                 $c1 =~ s/  *$//;
 114                 $c1 =~ s/^  *//;
 115 $c1 =~ s/-/\\-/g;
 116                 $c2 =~ s/^  *//;
 117 $examples .= <<".";
 118 $c2
 119 .Bd -literal -offset indent -compact
 120 $c1
 121 .Ed
 122 .
 123                 # (
 124                 if (/"\)/) {
 125                         undef $mode;
 126                 }
 127         }
 128 }
 129
 130 # for my $q ( @operations) {
 131 #       print "\nshort=".$$q{'short'}."\n";
 132 #       print "name=".$$q{'name'}."\n";
 133 #       print "desc=".$$q{'description'}."\n";
 134 #       if (defined($$q{'alias'})) {
 135 #               print "alias=".join(',',@{ $$q{'alias'}})."\n";
 136 #       }
 137 # }
 138
 139 sub long2nroff {
 140         my $f = shift;
 141         if ($f !~ /^-/) {
 142                 $f = "Fl -$f";
 143         }
 144         $f =~ s/-/\\-/g;
 145         return $f;
 146 }
 147
 148 sub format_options
 149 {
 150         my $h = shift;
 151         my $r;
 152         for my $q ( @$h ) {
 153                 $r .= ".It";
 154                 my @functions;
 155                 push @functions, " Fl ".$$q{'short'} if defined($$q{'short'});
 156                 push @functions, " ".long2nroff($$q{'name'});
 157                 push @functions, join(' ', '', map {long2nroff $_} @{ $$q{'alias'} })
 158                         if defined($$q{'alias'});
 159                 $r .= join(' ,', @functions);
 160                 if (defined($$q{'operand'})) {
 161                         if ($#functions > 0) {
 162                                 $r .= " ";
 163                         } else {
 164                                 $r .= " Ns \\= Ns ";
 165                         }
 166                         $r .= "Ar ".$$q{'operand'};
 167                 }
 168                 $r .= "\n".$$q{'description'}."\n";
 169                 $r .= $$q{'extra'};
 170         }
 171         return $r;
 172 }
 173
 174 sub optionkeyword
 175 {
 176         my $h = shift;
 177         my $k = $$h{'short'};
 178         $k = $$h{'name'} if !defined($k);
 179         my $l = $k;
 180         if ($l =~ s/^no-//) {
 181                 $l .= "-no";
 182         }
 183         return ($l,$k);
 184 }
 185
 186 sub optioncmp
 187 {
 188         my ($x1, $x2) = optionkeyword($a);
 189         my ($y1, $y2) = optionkeyword($b);
 190         my $r = lc($x1) cmp lc($y1);
 191         return $r if $r;
 192         $r = $y1 cmp $x1;
 193         return $r if $r;
 194         return $x2 cmp $y2;
 195 }
 196
 197 @operations = sort optioncmp @operations;
 198 @operations = sort optioncmp @operations;
 199 @options = sort optioncmp @options;
 200 @formats = sort optioncmp @formats;
 201
 202 if ($#formats >= 0 && !$saw_format) {
 203         print STDERR "FIXME: saw --format=X but no root --format!\n";
 204         exit(1);
 205 }
 206
 207 my $function_letters;
 208 my $short_letters = join('', sort @short);
 209 my $option_letters;
 210 my $format_letters;
 211 my $command_string = <<".";
 212 .Nm tar
 213 .
 214 $command_string .= ".Oo Fl Oc";
 215 my $env_variables;
 216 my %env_description = (
 217 'SIMPLE_BACKUP_SUFFIX' => <<".",
 218 Backup prefix to use when extracting, if
 219 .Fl \\-suffix
 220 is not specified.
 221 The backup suffix defaults to `~' if neither is specified.
 222 .
 223 'TAPE' => <<".",
 224 Device or file to use for the archive if
 225 .Fl \\-file
 226 is not specified.
 227 If this environment variable is unset, use stdin or stdout instead.
 228 .
 229 'TAR_OPTIONS' => <<".",
 230 Options to prepend to those specified on the command line, separated by
 231 whitespace.  Embedded backslashes may be used to escape whitespace or
 232 backslashes within an option.
 233 .
 234 );
 235 my $sep = "";
 236 for my $q ( @operations) {
 237         $command_string .= " Cm";
 238         $command_string .= $sep;
 239         $command_string .= " ".$$q{'short'} if defined($$q{'short'});
 240         $command_string .= " ".long2nroff($$q{'name'});
 241         if (defined($$q{'alias'})) {
 242                 my $t = join(' ', '', map{long2nroff $_} @{ $$q{'alias'} });
 243                 $t =~ s/ Fl / /g;
 244                 $command_string .= $t;
 245         }
 246         $sep = " \\||\\|";
 247 }
 248 $function_letters = ".Bl -tag -width flag\n";
 249 $function_letters .= format_options(\@operations);
 250 $function_letters .= ".El";
 251 if ($#formats >= 0) {
 252         $format_letters = ".Bl -tag -width flag\n";
 253         $format_letters .= format_options(\@formats);
 254         $format_letters .= ".El\n";
 255         $$saw_format{'extra'} = $format_letters;
 256 }
 257 ### Ar Cm Ic Li Nm Op Pa Va
 258 $option_letters = ".Bl -tag -width flag\n";
 259 $option_letters .= format_options(\@options);
 260 $option_letters .= ".El";
 261 $env_variables .= ".Bl -tag -width Ds\n";
 262 for my $q ( @env_vars) {
 263         $env_variables .= ".It Ev $q\n";
 264         $env_variables .= $env_description{$q};
 265 }
 266 $env_variables .= ".El";
 267
 268 $examples =~ s/\n$//;
 269 $function_letters =~ s/\n$//;
 270 $option_letters =~ s/\n$//;
 271 $env_variables =~ s/\n$//;
 272 print <<".";
 273 .\\" generated by script on $t
 274 .Dd $datestr
 275 .Dt TAR 1
 276 .Sh NAME
 277 .Nm tar
 278 .Nd The GNU version of the tar archiving utility
 279 .Sh SYNOPSIS
 280 $command_string
 281 .Op Ar options
 282 .Op Ar pathname ...
 283 .Sh DESCRIPTION
 284 .Nm Tar
 285 stores and extracts files from a tape or disk archive.
 286 .Pp
 287 The first argument to
 288 tar
 289 should be a function; either one of the letters
 290 .Cm $short_letters ,
 291 or one of the long function names.
 292 A function letter need not be prefixed with ``\\-'', and may be combined
 293 with other single-letter options.
 294 A long function name must be prefixed with
 295 .Cm \\\\-\\\\- .
 296 Some options take a parameter; with the single-letter form
 297 these must be given as separate arguments.
 298 With the long form, they may be given by appending
 299 .Cm = Ns Ar value
 300 to the option.
 301 .Sh FUNCTION LETTERS
 302 Main operation mode:
 303 $function_letters
 304 .Sh OTHER OPTIONS
 305 Operation modifiers:
 306 $option_letters
 307 .Sh ENVIRONMENT
 308 The behavior of tar is controlled by the following environment variables,
 309 among others:
 310 $env_variables
 311 .Sh EXAMPLES
 312 $examples
 313 .Sh SEE ALSO
 314 .\\" libarchive
 315 .Xr tar 5 ,
 316 .\\" man-pages
 317 .Xr symlink 7 ,
 318 .Xr rmt 8
 319 .Sh HISTORY
 320 The
 321 .Nm tar
 322 command appeared in
 323 .At v7 .
 324 .Sh BUGS
 325 The GNU folks, in general, abhor man pages, and create info documents instead.
 326 Unfortunately, the info document describing tar is licensed under the GFDL with
 327 invariant cover texts, which makes it impossible to include any text
 328 from that document in this man page.
 329 Most of the text in this document was automatically extracted from the usage
 330 text in the source.
 331 It may not completely describe all features of the program.
 332 .
 333 __END__