1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
|
#! perl
# Parser.pm -- Getopt::Long object-oriented interface
# Author : Johan Vromans
# Created On : Thu Nov 9 10:37:00 2023
# Last Modified On: Tue Jun 11 13:17:57 2024
# Update Count : 16
# Status : Released
use strict;
use warnings;
package Getopt::Long::Parser;
# Must match Getopt::Long::VERSION!
our $VERSION = 2.58;
=head1 NAME
Getopt::Long::Parser - Getopt::Long object-oriented interface
=head1 SYNOPSIS
use Getopt::Long::Parser;
my $p = Getopt::Long::Parser->new;
$p->configure( %options );
if ( $p->getoptions( @options ) ) { ... }
if ( $p->getoptionsfromarray( \@array, @options ) ) { ... }
Configuration options can be passed to the constructor:
my $p = Getopt::Long::Parser->new( config => [ %options ] );
=head1 DESCRIPTION
C<Getopt::Long::Parser> is an object-oriented interface to
L<Getopt::Long>. See its documentation for configuration and use.
Note that C<Getopt::Long> and C<Getopt::Long::Parser> are not
object-oriented.
C<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, C<$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
my $res = $p->getoptionsfromarray( $aref, @opts );
=head2 getoptions
my $res = $p->getoptions( @opts );
The same as C<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;
|
