summaryrefslogtreecommitdiff
path: root/Build/source/utils/texi2html/MySimple.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source/utils/texi2html/MySimple.pm')
-rw-r--r--Build/source/utils/texi2html/MySimple.pm236
1 files changed, 236 insertions, 0 deletions
diff --git a/Build/source/utils/texi2html/MySimple.pm b/Build/source/utils/texi2html/MySimple.pm
new file mode 100644
index 00000000000..75c25dc5d0d
--- /dev/null
+++ b/Build/source/utils/texi2html/MySimple.pm
@@ -0,0 +1,236 @@
+package Getopt::MySimple;
+
+# Name:
+# Getopt::MySimple.
+#
+# Documentation:
+# POD-style (incomplete) documentation is in file MySimple.pod
+#
+# Tabs:
+# 4 spaces || die.
+#
+# Author:
+# Ron Savage rpsavage@ozemail.com.au.
+# 1.00 19-Aug-97 Initial version.
+# 1.10 13-Oct-97 Add arrays of switches (eg '=s@').
+# 1.20 3-Dec-97 Add 'Help' on a per-switch basis.
+# 1.30 11-Dec-97 Change 'Help' to 'verbose'. Make all hash keys lowercase.
+# 1.40 10-Nov-98 Change width of help report. Restructure tests.
+# 1-Jul-00 Modifications for Texi2html
+
+# --------------------------------------------------------------------------
+# Locally modified by obachman (Display type instead of env, order by cmp)
+# $Id: MySimple.pm,v 1.4 2004/02/10 00:12:42 pertusus Exp $
+
+# use strict;
+# no strict 'refs';
+
+use vars qw(@EXPORT @EXPORT_OK @ISA);
+use vars qw($fieldWidth $opt $VERSION);
+
+use Exporter();
+use Getopt::Long;
+
+@ISA = qw(Exporter);
+@EXPORT = qw();
+@EXPORT_OK = qw($opt); # An alias for $self -> {'opt'}.
+
+# --------------------------------------------------------------------------
+
+$fieldWidth = 20;
+$VERSION = '1.41';
+
+# --------------------------------------------------------------------------
+
+sub byOrder
+{
+ my($self) = @_;
+
+ return uc($a) cmp (uc($b));
+}
+
+# --------------------------------------------------------------------------
+
+sub dumpOptions
+{
+ my($self) = @_;
+
+ print 'Option', ' ' x ($fieldWidth - length('Option') ), "Value\n";
+
+ for (sort byOrder keys(%{$self -> {'opt'} }) )
+ {
+ print "-$_", ' ' x ($fieldWidth - (1 + length) ), "${$self->{'opt'} }{$_}\n";
+ }
+
+ print "\n";
+
+} # End of dumpOptions.
+
+# --------------------------------------------------------------------------
+# Return:
+# 0 -> Error.
+# 1 -> Ok.
+
+sub getOptions
+{
+ push(@_, 0) if ($#_ == 2); # Default for $ignoreCase is 0.
+ push(@_, 1) if ($#_ == 3); # Default for $helpThenExit is 1.
+
+ my($self, $default, $helpText, $versionText,
+ $helpThenExit, $versionThenExit, $ignoreCase) = @_;
+
+ $helpThenExit = 1 unless (defined($helpThenExit));
+ $versionThenExit = 1 unless (defined($versionThenExit));
+ $ignoreCase = 0 unless (defined($ignoreCase));
+
+ $self -> {'default'} = $default;
+ $self -> {'helpText'} = $helpText;
+ $self -> {'versionText'} = $versionText;
+ $Getopt::Long::ignorecase = $ignoreCase;
+
+ unless (defined($self -> {'default'}{'help'}))
+ {
+ $self -> {'default'}{'help'} =
+ {
+ type => ':i',
+ default => '',
+ linkage => sub {$self->helpOptions($_[1]); sleep 5;exit (0) if $helpThenExit;},
+ verbose => "print help and exit"
+ };
+ }
+
+ unless (defined($self -> {'default'}{'version'}))
+ {
+ $self -> {'default'}{'version'} =
+ {
+ type => '',
+ default => '',
+ linkage => sub {print $self->{'versionText'}; exit (0) if $versionThenExit;},
+ verbose => "print version and exit"
+ };
+ }
+
+ for (keys(%{$self -> {'default'} }) )
+ {
+ my $type = ${$self -> {'default'} }{$_}{'type'};
+ push(@{$self -> {'type'} }, "$_$type");
+ $self->{'opt'}->{$_} = ${$self -> {'default'} }{$_}{'linkage'}
+ if ${$self -> {'default'} }{$_}{'linkage'};
+ }
+
+ my($result) = &GetOptions($self -> {'opt'}, @{$self -> {'type'} });
+
+ return $result unless $result;
+
+ for (keys(%{$self -> {'default'} }) )
+ {
+ if (! defined(${$self -> {'opt'} }{$_})) #{
+ {
+ ${$self -> {'opt'} }{$_} = ${$self -> {'default'} }{$_}{'default'};
+ }
+ }
+
+ $result;
+} # End of getOptions.
+
+# --------------------------------------------------------------------------
+
+sub helpOptions
+{
+ my($self) = shift;
+ my($noHelp) = shift;
+ $noHelp = 0 unless $noHelp;
+ my($optwidth, $typewidth, $defaultwidth, $maxlinewidth, $valind, $valwidth)
+ = (10, 5, 9, 78, 4, 11);
+
+ print "$self->{'helpText'}" if ($self -> {'helpText'});
+
+ print ' Option', ' ' x ($optwidth - length('Option') -1 ),
+ 'Type', ' ' x ($typewidth - length('Type') + 1),
+ 'Default', ' ' x ($defaultwidth - length('Default') ),
+ "Description\n";
+
+ for (sort byOrder keys(%{$self -> {'default'} }) )
+ {
+ my($line, $help, $option, $val);
+ $option = $_;
+ next if ${$self->{'default'} }{$_}{'noHelp'} && ${$self->{'default'} }{$_}{'noHelp'} > $noHelp;
+ #$line = " -$_" . ' ' x ($optwidth - (2 + length) ) .
+ # "${$self->{'default'} }{$_}{'type'} ".
+ # ' ' x ($typewidth - (1+length(${$self -> {'default'} }{$_}{'type'}) ));
+ $line = " --$_" . "${$self->{'default'} }{$_}{'type'}".
+ ' ' x ($typewidth - (1+length(${$self -> {'default'} }{$_}{'type'}) ));
+
+ $val = ${$self->{'default'} }{$_}{'linkage'};
+ if ($val)
+ {
+ if (ref($val) eq 'SCALAR')
+ {
+ $val = $$val;
+ }
+ else
+ {
+ $val = '';
+ }
+ }
+ else
+ {
+ $val = ${$self->{'default'} }{$_}{'default'};
+ }
+ $line .= "$val ";
+ $line .= ' ' x ($optwidth + $typewidth + $defaultwidth + 1 - length($line));
+
+ if (defined(${$self -> {'default'} }{$_}{'verbose'}) &&
+ ${$self -> {'default'} }{$_}{'verbose'} ne '')
+ {
+ $help = "${$self->{'default'} }{$_}{'verbose'}";
+ }
+ else
+ {
+ $help = ' ';
+ }
+ if ((length("$line") + length($help)) < $maxlinewidth)
+ {
+ print $line , $help, "\n";
+ }
+ else
+ {
+ print $line, "\n", ' ' x $valind, $help, "\n";
+ }
+ for $val (sort byOrder keys(%{${$self->{'default'}}{$option}{'values'}}))
+ {
+ print ' ' x ($valind + 2);
+ print $val, ' ', ' ' x ($valwidth - length($val) - 2);
+ print ${$self->{'default'}}{$option}{'values'}{$val}, "\n";
+ }
+ }
+
+ print <<EOT;
+Note: 'Options' may be abbreviated. 'Type' specifications mean:
+ <none>| ! no argument: variable is set to 1 on -foo (or, to 0 on -nofoo)
+ =s | :s mandatory (or, optional) string argument
+ =i | :i mandatory (or, optional) integer argument
+EOT
+} # End of helpOptions.
+
+#-------------------------------------------------------------------
+
+sub new
+{
+ my($class) = @_;
+ my($self) = {};
+ $self -> {'default'} = {};
+ $self -> {'helpText'} = '';
+ $self -> {'opt'} = {};
+ $opt = $self -> {'opt'}; # An alias for $self -> {'opt'}.
+ $self -> {'type'} = ();
+
+ return bless $self, $class;
+
+} # End of new.
+
+# --------------------------------------------------------------------------
+
+1;
+
+# End MySimple.pm