New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Option.pm in branches/UKMO/dev_r5518_nemo_fabm_ukmo/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI – NEMO

source: branches/UKMO/dev_r5518_nemo_fabm_ukmo/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Option.pm @ 7827

Last change on this file since 7827 was 7827, checked in by dford, 7 years ago

Remove svn keywords.

File size: 4.2 KB
Line 
1# ------------------------------------------------------------------------------
2# (C) Crown copyright Met Office. All rights reserved.
3# For further details please refer to the file COPYRIGHT.txt
4# which you should have received as part of this distribution.
5# ------------------------------------------------------------------------------
6use strict;
7use warnings;
8
9package Fcm::CLI::Option;
10
11use constant NO_ARG     => 0;
12use constant SCALAR_ARG => 1;
13use constant ARRAY_ARG  => 2;
14use constant HASH_ARG   => 3;
15use constant ARG_STRING_SUFFIX_FOR => (q{}, q{=s}, q{=s@}, q{=s%});
16
17################################################################################
18# Constructor
19sub new {
20    my ($class, $args_ref) = @_;
21    return bless({%{$args_ref}}, $class);
22}
23
24################################################################################
25# Methods: get_*
26for my $key (
27    # Returns the delimiter of this option, if it is an array
28    'delimiter',
29    # Returns the description of this option
30    'description',
31    # Returns the (long) name of this option
32    'name',
33) {
34    no strict qw{refs};
35    my $getter = "get_$key";
36    *$getter = sub {
37        my ($self) = @_;
38        return $self->{$key};
39    }
40}
41
42################################################################################
43# Returns the letter of this option
44sub get_letter {
45    my ($self) = @_;
46    if (defined($self->{letter})) {
47        return substr($self->{letter}, 0, 1);
48    }
49    else {
50        return;
51    }
52}
53
54################################################################################
55# Returns whether the current option has no, scalar, array or hash arguments
56sub has_arg {
57    my ($self) = @_;
58    return (defined($self->{has_arg}) ? $self->{has_arg} : $self->NO_ARG);
59}
60
61################################################################################
62# Returns true if this option is associated with help
63sub is_help {
64    my ($self) = @_;
65    return $self->{is_help};
66}
67
68################################################################################
69# Returns an option string/reference pair for Getopt::Long::GetOptions
70sub get_arg_for_getopt_long {
71    my ($self) = @_;
72    my $option_string
73        = $self->get_name()
74          . ($self->get_letter() ? q{|} . $self->get_letter() : q{})
75          . (ARG_STRING_SUFFIX_FOR)[$self->has_arg()]
76          ;
77    return $option_string;
78}
79
801;
81__END__
82
83=head1 NAME
84
85Fcm::CLI::Option
86
87=head1 SYNOPSIS
88
89    use Fcm::CLI::Option;
90    $option = Fcm::CLI::Option->new({
91        name        => 'name',
92        letter      => 'n',
93        has_arg     => Fcm::CLI::Option->SCALAR_ARG,
94        is_help     => 1,
95        description => 'an example option',
96    });
97
98    # time passes ...
99    use Getopt::Long qw{GetOptions};
100    $success = GetOptions(
101        \%hash,
102        $option->get_arg_for_getopt_long(), # ('name|n=s')
103        # and other options ...
104    );
105    $option_value = $option->get_value();
106
107=head1 DESCRIPTION
108
109An object of this class represents a CLI option.
110
111=head1 METHODS
112
113=over 4
114
115=item new($args_ref)
116
117Constructor.
118
119=item get_arg_for_getopt_long()
120
121Returns an option string for this option that is suitable for use as arguments
122to L<Getopt::Long|Getopt::Long>.
123
124=item get_description()
125
126Returns a description of this option.
127
128=item get_delimiter()
129
130Returns the delimiter of this option. This is only relevant if has_arg() is
131equal to C<ARRAY_ARG>. If set, the argument for this option should be re-grouped
132using this delimiter.
133
134=item get_name()
135
136Returns the (long) name of this option.
137
138=item get_letter()
139
140Returns the option letter of this option.
141
142=item has_arg()
143
144Returns whether this option has no, scalar, array or hash arguments. See
145L</CONSTANTS> for detail.
146
147=item is_help()
148
149Returns true if this option is associated with help.
150
151=back
152
153=head1 CONSTANTS
154
155=over 4
156
157=item NO_ARG
158
159An option has no argument. (Default)
160
161=item SCALAR_ARG
162
163An option has a single scalar argument.
164
165=item ARRAY_ARG
166
167An option has multiple arguments, which can be placed in an array.
168
169=item HASH_ARG
170
171An option has multiple arguments, which can be placed in an hash.
172
173=back
174
175=head1 SEE ALSO
176
177L<Getopt::Long|Getopt::Long>
178
179=head1 COPYRIGHT
180
181E<169> Crown copyright Met Office. All rights reserved.
182
183=cut
Note: See TracBrowser for help on using the repository browser.