#! /usr/local/bin/perl eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}' if 0; # -*- Perl -*- # Copyright (C) 1997, 1998 Motoyuki Kasahara # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # This program is a Perl package running on Perl 4.036 or later. # The package provides routines to process command line options like # as GNU getopt_long(). # # Version: # 2.0.2 # # Interface: # # &getopt_initialize(LIST) # Set a list of command line options and initialize internal data # for &getopt_long. # You must call the routine before calling &getopt_long. # Format of each element in the LIST is: # # `CANONICAL-OPTION-NAME [ALIAS-OPTION-NAME...] ARGUMENT-FLAG' # # CANONICAL-OPTION-NAME, ALIAS-OPTION-NAME and ARGUMENT-FLAG fields # are separated by spaces or tabs. # # CANONICAL-OPTION-NAME and ALIAS-OPTION-NAME must be either a single # character option including preceding `-' (e.g. `-v'), or a long # name option including preceding `--' (e.g. `--version'). Whether # CANONICAL-OPTION-NAME is single character option or long name # option is not significant. # # ARGUMENT-FLAG must be `no-argument', `required-argument' or # `optional-argument'. If it is set to `required-argument', the # option always takes an argument. If set to `optional-argument', # an argument to the option is optional. # # You can put a special element `+' or `-' at the first element in # LIST. See `Details about Option Processing:' for details. # If succeeded to initialize, 1 is returned. Otherwise 0 is # returned. # # &getopt_long # Get a option name, and if exists, its argument of the leftmost # option in @ARGV. # # An option name and its argument are returned as a list with two # elements; the first element is CANONICAL-OPTION-NAME of the option, # and second is its argument. # Upon return, the option and its argument are removed from @ARGV. # When you have already got all options in @ARGV, an empty list is # returned. In this case, only non-option elements are left in # @ARGV. # # When an error occurs, an error message is output to standard # error, and the option name in a returned list is set to `?'. # # Example: # # &getopt_intialize('--help -h no-argument', '--version -v no-argument') # || die; # # while (($name, $arg) = &getopt_long) { # die "For help, type \`$0 --help\'\n" if ($name eq '?'); # $opts{$name} = $arg; # } # # Details about Option Processing: # # * There are three processing modes: # 1. PERMUTE # It permutes the contents of ARGV as it scans, so that all the # non-option ARGV-elements are at the end. This mode is default. # 2. REQUIRE_ORDER # It stops option processing when the first non-option is seen. # This mode is chosen if the environment variable POSIXLY_CORRECT # is defined, or the first element in the option list is `+'. # 3. RETURN_IN_ORDER # It describes each non-option ARGV-element as if it were the # argument of an option with an empty name. # This mode is chosen if the first element in the option list is # `-'. # # * An argument starting with `-' and not exactly `-', is a single # character option. # If the option takes an argument, it must be specified at just # behind the option name (e.g. `-f/tmp/file'), or at the next # ARGV-element of the option name (e.g. `-f /tmp/file'). # If the option doesn't have an argument, other single character # options can be followed within an ARGV-element. For example, # `-l -g -d' is identical to `-lgd'. # # * An argument starting with `--' and not exactly `--', is a long # name option. # If the option has an argument, it can be specified at behind the # option name preceded by `=' (e.g. `--option=argument'), or at the # next ARGV-element of the option name (e.g. `--option argument'). # Long name options can be abbreviated as long as the abbreviation # is unique. # # * The special argument `--' forces an end of option processing. # { package getopt_long; $initflag = 0; $REQUIRE_ORDER = 0; $PERMUTE = 1; $RETURN_IN_ORDER = 2; } # # Initialize the internal data. # sub getopt_initialize { local(@fields); local($name, $flag, $canon); local($_); # # Determine odering. # if ($_[$[] eq '+') { $getopt_long'ordering = $getopt_long'REQUIRE_ORDER; shift(@_); } elsif ($_[$[] eq '-') { $getopt_long'ordering = $getopt_long'RETURN_IN_ORDER; shift(@_); } elsif (defined($ENV{'POSIXLY_CORRECT'})) { $getopt_long'ordering = $getopt_long'REQUIRE_ORDER; } else { $getopt_long'ordering = $getopt_long'PERMUTE; } # # Parse an option list. # %getopt_long'optnames = (); %getopt_long'argflags = (); foreach (@_) { @fields = split(/[ \t]+/, $_); if (@fields < 2) { warn "$0: (getopt_initialize) too few fields \`$arg\'\n"; return 0; } $flag = pop(@fields); if ($flag ne 'no-argument' && $flag ne 'required-argument' && $flag ne 'optional-argument') { warn "$0: (getopt_initialize) invalid argument flag \`$flag\'\n"; return 0; } $canon = ''; foreach $name (@fields) { if ($name !~ /^-([^-]|-.+)$/) { warn "$0: (getopt_initialize) invalid option name \`$name\'\n"; return 0; } elsif (defined($getopt_long'optnames{$name})) { warn "$0: (getopt_initialize) redefined option \`$name\'\n"; return 0; } $canon = $name if ($canon eq ''); $getopt_long'optnames{$name} = $canon; $getopt_long'argflags{$name} = $flag; } } $getopt_long'endflag = 0; $getopt_long'shortrest = ''; @getopt_long'nonopts = (); $getopt_long'initflag = 1; } # # When it comes to the end of options, restore PERMUTEd non-option # arguments to @ARGV. # sub getopt_end { $getopt_long'endflag = 1; unshift(@ARGV, @getopt_long'nonopts); } # # Scan elements of @ARGV for getting an option. # sub getopt_long { local($name, $arg) = ('?', ''); local($key, $pattern, $match_count, $ch); local($_); &getopt_initialize(@_) if (!$getopt_long'initflag); return () if ($getopt_long'endflag); # # Get next option argument. # if ($getopt_long'shortrest ne '') { $_ = '-'.$getopt_long'shortrest; } elsif (@ARGV == 0) { &getopt_end; return (); } elsif ($getopt_long'ordering == $getopt_long'PERMUTE) { while (0 < @ARGV && $ARGV[$[] !~ /^-./) { push(@getopt_long'nonopts, shift(@ARGV)); } if (@ARGV == 0) { &getopt_end; return (); } $_ = shift(@ARGV); } elsif ($getopt_long'ordering == $getopt_long'REQUIRE_ORDER) { $_ = shift(@ARGV); if (!/^-./) { push(@getopt_long'nonopts, $_); &getopt_end; return (); } } else { # $getopt_long'ordering == RETURN_IN_ORDER $_ = shift(@ARGV); } # # Check the special argument `--'. # `--' indicates the end of the option list. # if ($_ eq '--' && $getopt_long'shortrest eq '') { # # `--' indicates the end of the option list. # &getopt_end; return (); } # # Check for long and short options. # if (/^(--[^=]+)/ && $getopt_long'shortrest eq '') { # # This is a long style option, which start with `--'. # $pattern = $1; if (defined($getopt_long'optnames{$pattern})) { $name = $pattern; } else { # # The option `name' is not registered in `@optnames'. # It may be an abbreviated # $match_count = 0; foreach $key (keys(%getopt_long'optnames)) { if (index($key, $pattern) == 0) { $name = $key; $match_count++; } } if (2 <= $match_count) { warn "$0: option \`$_\' is ambiguous\n"; return ('?', ''); } elsif ($match_count == 0) { warn "$0: unrecognized option \`$_\'\n"; return ('?', ''); } } # # Check an argument to the option. # if ($getopt_long'argflags{$name} eq 'required-argument') { if (/=(.*)$/) { $arg = $1; } elsif (0 < @ARGV) { $arg = shift(@ARGV); } else { warn "$0: option \`$_\' requires an argument\n"; return ('?', ''); } } elsif ($getopt_long'argflags{$name} eq 'optional-argument') { if (/=(.*)$/) { $arg = $1; } elsif (0 < @ARGV && $ARGV[$[] !~ /^-./) { $arg = shift(@ARGV); } else { $arg = ''; } } elsif (/=(.*)$/) { warn "$0: option \`$name\' doesn't allow an argument\n"; return ('?', ''); } } elsif (/^(-(.))(.*)/) { # # This is a short style option, which start with `-' (not `--'). # Short options may be catinated (e.g. `-l -g' is equivalent to # `-lg'). # ($name, $ch, $getopt_long'shortrest) = ($1, $2, $3); if (defined($getopt_long'optnames{$name})) { # # The option `name' is found in `@optnames'. # Check its argument. # if ($getopt_long'argflags{$name} eq 'required-argument') { if ($getopt_long'shortrest ne '') { $arg = $getopt_long'shortrest; $getopt_long'shortrest = ''; } elsif (0 < @ARGV) { $arg = shift(@ARGV); } else { # 1003.2 specifies the format of this message. warn "$0: option requires an argument -- $ch\n"; return ('?', ''); } } elsif ($getopt_long'argflags{$name} eq 'optional-argument') { if ($getopt_long'shortrest ne '') { $arg = $getopt_long'shortrest; $getopt_long'shortrest = ''; } elsif (0 < @ARGV && $ARGV[$[] !~ /^-./) { $arg = shift(@ARGV); } else { $arg = ''; } } } else { # # This is an invalid option. # 1003.2 specifies the format of this message. # if (defined($ENV{'POSIXLY_CORRECT'})) { warn "$0: illegal option -- $ch\n"; return ('?', ''); } else { warn "$0: invalid option -- $ch\n"; return ('?', ''); } } } else { # # This is a non-option argument. # Only RETURN_IN_ORDER falled into here. # return ('', $_); } return ($getopt_long'optnames{$name}, $arg); } 1; # -*- Perl -*- # info2txt -- Convert a Info document to plain text. # # Copyright (C) 1997 Motoyuki Kasahara # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}' if 0; # Program name, version and mailing address $progname ='info2txt'; $version = '1.2'; $mailing_address = '@MAILING_ADDRESS@'; $help = "Usage: $progname [option...] [info-file] Options: -h, --help display this help, then exit -S, --no-split don\'t read split info-files -v, --version display version number, then exit Report bugs to $mailing_address. "; $tryhelp = "try \`$0 --help\' for more information\n"; @option_list = ('-h --help no-argument', '-S --no-split no-argument', '-v --version no-argument'); $columns = 70; # # Parse command line options. # $split_mode = 1; &getopt_initialize(@option_list); while (($opt, $arg) = &getopt_long) { if ($opt eq '-h') { print $help; exit(0); } elsif ($opt eq '-S') { $split_mode = 0; } elsif ($opt eq '-v') { print "$progname version $version\n\n"; print "Copyright (c) 1997, 1998 Motoyuki Kasahara\n\n"; print "This is free software; you can redistribute it and/or modify\n"; print "it under the terms of the GNU General Public License as published by\n"; print "the Free Software Foundation; either version 2, or (at your optio n)\n"; print "any later version.\n\n"; print "This program is distributed in the hope that it will be useful,\n "; print "but WITHOUT ANY WARRANTY; without even the implied warranty\n"; print "of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n"; print "GNU General Public License for more details.\n"; exit(0); } else { die $tryhelp; } } die "too many arguments\n$tryhelp" if (2 <= @ARGV); # # Search `info-file-1', `info-file-2', ... when `--no-split' and `-S' # are not specified. # if ($split_mode && @ARGV == 1 && -f "$ARGV[0]-1") { $basename = pop(@ARGV); push(@ARGV, "$basename-1"); for ($i = 2; -f "$basename-$i"; $i++) { push(@ARGV, "$basename-$i"); } } # # Main loop. # ($STATUS_TEXT, $STATUS_DIR_ENTRY, $STATUS_NODE, $STATUS_MENU) = (0..4); while (<>) { if (/Tag Table:/) { last; } elsif (/^START-INFO-DIR-ENTRY/) { $status = $STATUS_DIR_ENTRY; $dir_entry++; } elsif (/^END-INFO-DIR-ENTRY/) { $status = $STATUS_TEXT; print "\n" if ($dir_entry == 1); } elsif (/^\* Menu:/) { $status = $STATUS_MENU; } elsif (/^\037/) { $status = $STATUS_NODE; } elsif ($status == $STATUS_NODE && /Node: Top,/) { $top_node = 1; } elsif ($status == $STATUS_DIR_ENTRY && $dir_entry == 1) { if (($name, $title) = /^\* ([^:]*): \([^\)]*\)\.[ \t]+(.*)$/) { $is_title = 1; $namepad = ($columns - length($name)) / 2; $titlepad = ($columns - length($title)) / 2; print "\n"; print ' ' x $namepad if (0 < $namepad); print "$name\n"; print ' ' x $titlepad if (0 < $titlepad); print "$title\n"; } elsif (s/^[ \t]+// && $is_title) { chop; $titlepad = ($columns - length($_)) / 2; print ' ' x $titlepad if (0 < $titlepad); print "$_\n"; } else { $is_title = 0; } } else { print if ($status == $STATUS_TEXT && $top_node); $status = $STATUS_TEXT if ($status == $STATUS_NODE); } } # Local Variables: # mode: perl # End: