Added Cyg-Win

Agent-Windows/OGP64/usr/share/perl5/5.40/Getopt/Long/Parser.pm

@@ -0,0 +1,177 @@
+#! perl
+
+# Parser.pm -- Getopt::Long object oriented interface
+# Author          : Johan Vromans
+# Created On      : Thu Nov  9 10:37:00 2023
+# Last Modified On: Sat Nov 11 17:48:49 2023
+# Update Count    : 13
+# Status          : Released
+
+package Getopt::Long::Parser;
+
+our $VERSION = 2.57;
+
+=head1 NAME
+
+Getopt::Long::Parser - Getopt::Long object oriented interface
+
+=head1 SYNOPSIS
+
+    use Getopt::Long::Parser;
+    my $p = Getopt::Long::Parser->new;
+    $p->configure( ...configuration options... );
+    if ( $p->getoptions( ...options descriptions... ) ) ...
+    if ( $p->getoptionsfromarray( \@array, ...options descriptions... ) ) ...
+
+Configuration options can be passed to the constructor:
+
+    my $p = Getopt::Long::Parser->new
+             config => [...configuration options...];
+
+=head1 DESCRIPTION
+
+Getopt::Long::Parser is an object oriented interface to
+L<Getopt::Long>. See its documentation for configuration and use.
+
+Note that Getopt::Long and Getopt::Long::Parser are not object
+oriented. Getopt::Long::Parser emulates an object oriented interface,
+which should be okay for most purposes.
+
+=head1 CONSTRUCTOR
+
+    my $p = Getopt::Long::Parser->new( %options );
+
+The constructor takes an optional hash with parameters.
+
+=over 4
+
+=item config
+
+An array reference with configuration settings.
+See L<Getopt::Long/"Configuring Getopt::Long"> for all possible settings.
+
+=back
+
+=cut
+
+# Getopt::Long has a stub for Getopt::Long::Parser::new.
+use Getopt::Long ();
+no warnings 'redefine';
+
+sub new {
+    my $that = shift;
+    my $class = ref($that) || $that;
+    my %atts = @_;
+
+    # Register the callers package.
+    my $self = { caller_pkg => (caller)[0] };
+
+    bless ($self, $class);
+
+    my $default_config = Getopt::Long::_default_config();
+
+    # Process config attributes.
+    if ( defined $atts{config} ) {
+	my $save = Getopt::Long::Configure ($default_config, @{$atts{config}});
+	$self->{settings} = Getopt::Long::Configure ($save);
+	delete ($atts{config});
+    }
+    # Else use default config.
+    else {
+	$self->{settings} = $default_config;
+    }
+
+    if ( %atts ) {		# Oops
+	die(__PACKAGE__.": unhandled attributes: ".
+	    join(" ", sort(keys(%atts)))."\n");
+    }
+
+    $self;
+}
+
+use warnings 'redefine';
+
+=head1 METHODS
+
+In the examples, $p is assumed to be the result of a call to the constructor.
+
+=head2 configure
+
+    $p->configure( %settings );
+
+Update the current config settings.
+See L<Getopt::Long/"Configuring Getopt::Long"> for all possible settings.
+
+=cut
+
+sub configure {
+    my ($self) = shift;
+
+    # Restore settings, merge new settings in.
+    my $save = Getopt::Long::Configure ($self->{settings}, @_);
+
+    # Restore orig config and save the new config.
+    $self->{settings} = Getopt::Long::Configure ($save);
+}
+
+=head2 getoptionsfromarray
+
+    $res = $p->getoptionsfromarray( $aref, @opts );
+
+=head2 getoptions
+
+    $res = $p->getoptions( @opts );
+
+The same as getoptionsfromarray( \@ARGV, @opts ).
+
+=cut
+
+sub getoptions {
+    my ($self) = shift;
+
+    return $self->getoptionsfromarray(\@ARGV, @_);
+}
+
+sub getoptionsfromarray {
+    my ($self) = shift;
+
+    # Restore config settings.
+    my $save = Getopt::Long::Configure ($self->{settings});
+
+    # Call main routine.
+    my $ret = 0;
+    $Getopt::Long::caller = $self->{caller_pkg};
+
+    eval {
+	# Locally set exception handler to default, otherwise it will
+	# be called implicitly here, and again explicitly when we try
+	# to deliver the messages.
+	local ($SIG{__DIE__}) = 'DEFAULT';
+	$ret = Getopt::Long::GetOptionsFromArray (@_);
+    };
+
+    # Restore saved settings.
+    Getopt::Long::Configure ($save);
+
+    # Handle errors and return value.
+    die ($@) if $@;
+    return $ret;
+}
+
+=head1 SEE ALSO
+
+L<Getopt::Long>
+
+=head1 AUTHOR
+
+Johan Vromans <jvromans@squirrel.nl>
+
+=head1 COPYRIGHT AND DISCLAIMER
+
+This program is Copyright 1990,2015,2023 by Johan Vromans.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl.
+
+=cut
+
+1;

Agent-Windows/OGP64/usr/share/perl5/5.40/Getopt/Std.pm

@@ -0,0 +1,312 @@
+package Getopt::Std;
+
+use strict;
+use warnings;
+
+require Exporter;
+
+=head1 NAME
+
+Getopt::Std - Process single-character switches with switch clustering
+
+=head1 SYNOPSIS
+
+    use Getopt::Std;
+
+    getopts('oif:');  # -o & -i are boolean flags, -f takes an argument
+		      # Sets $opt_* global variables as a side effect
+    getopts('oif:', \my %opts);  # Options as above, values in %opts
+    getopt('oDI');    # -o, -D & -I take arguments
+                      # Sets $opt_* global variables as a side effect
+    getopt('oDI', \my %opts);    # -o, -D & -I take arg, values in %opts
+
+=head1 DESCRIPTION
+
+The C<getopts()> function processes single-character switches with switch
+clustering.  Pass one argument which is a string containing all switches to be
+recognized.  For each switch found, if an argument is expected and provided,
+C<getopts()> sets C<$opt_x> (where C<x> is the switch name) to the value of
+the argument.  If an argument is expected but none is provided, C<$opt_x> is
+set to an undefined value.  If a switch does not take an argument, C<$opt_x>
+is set to C<1>.
+
+Switches which take an argument don't care whether there is a space between
+the switch and the argument.  If unspecified switches are found on the
+command-line, the user will be warned that an unknown option was given.
+
+The C<getopts()> function returns true unless an invalid option was found.
+
+The C<getopt()> function is similar, but its argument is a string containing
+all switches that take an argument.  If no argument is provided for a switch,
+say, C<y>, the corresponding C<$opt_y> will be set to an undefined value.
+Unspecified switches are silently accepted.  Use of C<getopt()> is B<not
+recommended>.
+
+Note that, if your code is running under the recommended C<use strict
+vars> pragma, you will need to declare these package variables
+with C<our>:
+
+    our($opt_x, $opt_y);
+
+For those of you who don't like additional global variables being created,
+C<getopt()> and C<getopts()> will also accept a hash reference as an optional
+second argument.  Hash keys will be C<x> (where C<x> is the switch name) with
+key values the value of the argument or C<1> if no argument is specified.
+
+To allow programs to process arguments that look like switches, but aren't,
+both functions will stop processing switches when they see the argument
+C<-->.  The C<--> will be removed from C<@ARGV>.
+
+=head1 C<--help> and C<--version>
+
+If C<-> is not a recognized switch letter, C<getopts()> supports arguments
+C<--help> and C<--version>.  If C<main::HELP_MESSAGE()> and/or
+C<main::VERSION_MESSAGE()> are defined, they are called; the arguments are
+the output file handle, the name of option-processing package, its version,
+and the switches string.  If the subroutines are not defined, an attempt is
+made to generate intelligent messages; for best results, define C<$main::VERSION>.
+
+If embedded documentation (in pod format, see L<perlpod>) is detected
+in the script, C<--help> will also show how to access the documentation.
+
+Note that due to excessive paranoia, if C<$Getopt::Std::STANDARD_HELP_VERSION>
+isn't true (the default is false), then the messages are printed on C<STDERR>,
+and the processing continues after the messages are printed.  This being
+the opposite of the standard-conforming behaviour, it is strongly recommended
+to set C<$Getopt::Std::STANDARD_HELP_VERSION> to true.
+
+One can change the output file handle of the messages by setting
+C<$Getopt::Std::OUTPUT_HELP_VERSION>.  One can print the messages of C<--help>
+(without the C<Usage:> line) and C<--version> by calling functions C<help_mess()>
+and C<version_mess()> with the switches string as an argument.
+
+=cut
+
+our @ISA = qw(Exporter);
+our @EXPORT = qw(getopt getopts);
+our $VERSION = '1.14';
+# uncomment the next line to disable 1.03-backward compatibility paranoia
+# $STANDARD_HELP_VERSION = 1;
+
+# Process single-character switches with switch clustering.  Pass one argument
+# which is a string containing all switches that take an argument.  For each
+# switch found, sets $opt_x (where x is the switch name) to the value of the
+# argument, or 1 if no argument.  Switches which take an argument don't care
+# whether there is a space between the switch and the argument.
+
+# Usage:
+#	getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.
+
+sub getopt (;$$) {
+    my ($argumentative, $hash) = @_;
+    $argumentative = '' if !defined $argumentative;
+    my ($first, $rest);
+    local $_;
+    local @EXPORT;
+
+    while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
+	($first, $rest) = ($1, $2);
+	if (/^--$/) {	# early exit if --
+	    shift @ARGV;
+	    last;
+	}
+	if (index($argumentative, $first) >= 0) {
+	    if ($rest ne '') {
+		shift(@ARGV);
+	    }
+	    else {
+		shift(@ARGV);
+		$rest = shift(@ARGV);
+	    }
+	    if (ref $hash) {
+	        $$hash{$first} = $rest;
+	    }
+	    else {
+            no strict 'refs';
+	        ${"opt_$first"} = $rest;
+	        push( @EXPORT, "\$opt_$first" );
+	    }
+	}
+	else {
+	    if (ref $hash) {
+	        $$hash{$first} = 1;
+	    }
+	    else {
+            no strict 'refs';
+	        ${"opt_$first"} = 1;
+	        push( @EXPORT, "\$opt_$first" );
+	    }
+	    if ($rest ne '') {
+		$ARGV[0] = "-$rest";
+	    }
+	    else {
+		shift(@ARGV);
+	    }
+	}
+    }
+    unless (ref $hash) { 
+	local $Exporter::ExportLevel = 1;
+	Getopt::Std->import;
+    }
+}
+
+our ($OUTPUT_HELP_VERSION, $STANDARD_HELP_VERSION);
+sub output_h () {
+  return $OUTPUT_HELP_VERSION if defined $OUTPUT_HELP_VERSION;
+  return \*STDOUT if $STANDARD_HELP_VERSION;
+  return \*STDERR;
+}
+
+sub try_exit () {
+    exit 0 if $STANDARD_HELP_VERSION;
+    my $p = __PACKAGE__;
+    print {output_h()} <<EOM;
+  [Now continuing due to backward compatibility and excessive paranoia.
+   See 'perldoc $p' about \$$p\::STANDARD_HELP_VERSION.]
+EOM
+}
+
+sub version_mess ($;$) {
+    my $args = shift;
+    my $h = output_h;
+    if (@_ and defined &main::VERSION_MESSAGE) {
+	main::VERSION_MESSAGE($h, __PACKAGE__, $VERSION, $args);
+    } else {
+	my $v = $main::VERSION;
+	$v = '[unknown]' unless defined $v;
+	my $myv = $VERSION;
+	$myv .= ' [paranoid]' unless $STANDARD_HELP_VERSION;
+	my $perlv = $];
+	$perlv = sprintf "%vd", $^V if $] >= 5.006;
+	print $h <<EOH;
+$0 version $v calling Getopt::Std::getopts (version $myv),
+running under Perl version $perlv.
+EOH
+    }
+}
+
+sub help_mess ($;$) {
+    my $args = shift;
+    my $h = output_h;
+    if (@_ and defined &main::HELP_MESSAGE) {
+	main::HELP_MESSAGE($h, __PACKAGE__, $VERSION, $args);
+    } else {
+	my (@witharg) = ($args =~ /(\S)\s*:/g);
+	my (@rest) = ($args =~ /([^\s:])(?!\s*:)/g);
+	my ($help, $arg) = ('', '');
+	if (@witharg) {
+	    $help .= "\n\tWith arguments: -" . join " -", @witharg;
+	    $arg = "\nSpace is not required between options and their arguments.";
+	}
+	if (@rest) {
+	    $help .= "\n\tBoolean (without arguments): -" . join " -", @rest;
+	}
+	my ($scr) = ($0 =~ m,([^/\\]+)$,);
+	print $h <<EOH if @_;			# Let the script override this
+
+Usage: $scr [-OPTIONS [-MORE_OPTIONS]] [--] [PROGRAM_ARG1 ...]
+EOH
+	print $h <<EOH;
+
+The following single-character options are accepted:$help
+
+Options may be merged together.  -- stops processing of options.$arg
+EOH
+	my $has_pod;
+	if ( defined $0 and $0 ne '-e' and -f $0 and -r $0
+	     and open my $script, '<', $0 ) {
+	    while (<$script>) {
+		$has_pod = 1, last if /^=(pod|head1)/;
+	    }
+	}
+	print $h <<EOH if $has_pod;
+
+For more details run
+	perldoc -F $0
+EOH
+    }
+}
+
+# Usage:
+#   getopts('a:bc');	# -a takes arg. -b & -c not. Sets opt_* as a
+#			#  side effect.
+
+sub getopts ($;$) {
+    my ($argumentative, $hash) = @_;
+    my (@args, $first, $rest, $exit);
+    my $errs = 0;
+    local $_;
+    local @EXPORT;
+
+    @args = split( / */, $argumentative );
+    while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/s) {
+	($first, $rest) = ($1, $2);
+	if (/^--$/) {	# early exit if --
+	    shift @ARGV;
+	    last;
+	}
+	my $pos = index($argumentative, $first);
+	if ($pos >= 0) {
+	    if (defined($args[$pos+1]) and ($args[$pos+1] eq ':')) {
+		shift(@ARGV);
+		if ($rest eq '') {
+		    ++$errs unless @ARGV;
+		    $rest = shift(@ARGV);
+		}
+		if (ref $hash) {
+		    $$hash{$first} = $rest;
+		}
+		else {
+            no strict 'refs';
+		    ${"opt_$first"} = $rest;
+		    push( @EXPORT, "\$opt_$first" );
+		}
+	    }
+	    else {
+		if (ref $hash) {
+		    $$hash{$first} = 1;
+		}
+		else {
+            no strict 'refs';
+		    ${"opt_$first"} = 1;
+		    push( @EXPORT, "\$opt_$first" );
+		}
+		if ($rest eq '') {
+		    shift(@ARGV);
+		}
+		else {
+		    $ARGV[0] = "-$rest";
+		}
+	    }
+	}
+	else {
+	    if ($first eq '-' and $rest eq 'help') {
+		version_mess($argumentative, 'main');
+		help_mess($argumentative, 'main');
+		try_exit();
+		shift(@ARGV);
+		next;
+	    } elsif ($first eq '-' and $rest eq 'version') {
+		version_mess($argumentative, 'main');
+		try_exit();
+		shift(@ARGV);
+		next;
+	    }
+	    warn "Unknown option: $first\n";
+	    ++$errs;
+	    if ($rest ne '') {
+		$ARGV[0] = "-$rest";
+	    }
+	    else {
+		shift(@ARGV);
+	    }
+	}
+    }
+    unless (ref $hash) { 
+	local $Exporter::ExportLevel = 1;
+	Getopt::Std->import;
+    }
+    $errs == 0;
+}
+
+1;