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.
Help.pm in branches/UKMO/dev_r5518_nemo_fabm_ukmo/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker – NEMO

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

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

Remove svn keywords.

File size: 6.4 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::Invoker::Help;
10use base qw{Fcm::CLI::Invoker};
11
12use Carp qw{croak};
13use Fcm::CLI::Exception;
14use Fcm::CLI::Config;
15use Fcm::Config;
16use Fcm::Util qw{run_command};
17use IO::File;
18
19################################################################################
20# Invokes the sub-system
21sub invoke {
22    my ($self) = @_;
23    my @subcommand_names = $self->get_arguments();
24    if (@subcommand_names) {
25        for my $subcommand_name (@subcommand_names) {
26            my $help_string = $self->_get_help_for($subcommand_name);
27            if (!defined($help_string)) {
28                croak(Fcm::CLI::Exception->new({message => sprintf(
29                    "%s: unknown command", $subcommand_name,
30                )}));
31            }
32            print($help_string, "\n");
33        }
34    }
35    else {
36        print($self->_get_help());
37    }
38}
39
40################################################################################
41# Returns the help string for a subcommand matching $subcommand_name
42sub _get_help_for {
43    my ($self, $subcommand_name) = @_;
44    my $subcommand
45        = Fcm::CLI::Config->instance()->get_subcommand_of($subcommand_name);
46    if (!$subcommand) {
47        return;
48    }
49    if ($subcommand->is_vc()) {
50        my $invoker = $subcommand->get_invoker($subcommand_name);
51        local(@ARGV) = '--help';
52        $invoker->invoke();
53        return q{};
54    }
55    my $prog = Fcm::Config->instance()->setting('FCM_COMMAND');
56    # FIXME: can do with using Text::Template or Perl6::Form
57    my $help = sprintf(
58        "%s %s: %s\n",
59        $prog,
60        $subcommand->as_string(),
61        $subcommand->get_synopsis(),
62    );
63    $help .= sprintf(
64        "usage: %s %s %s\n",
65        $prog, $subcommand->get_names()->[0], $subcommand->get_usage(),
66    );
67    if ($subcommand->get_description()) {
68        my @lines = (q{}, split("\n", $subcommand->get_description()), q{});
69        $help .= join(qq{\n  }, @lines) . "\n";
70    }
71    if ($subcommand->get_options()) {
72        $help .= "Valid options:\n";
73        my $max_length_of_name = 0;
74        my @option_names;
75        for my $option ($subcommand->get_options()) {
76            if (length($option->get_name()) > $max_length_of_name) {
77                $max_length_of_name = length($option->get_name());
78            }
79        }
80        for my $option ($subcommand->get_options()) {
81            $help .= sprintf(
82                "  --%s%s%s%s : %s\n",
83                $option->get_name(),
84                q{ } x ($max_length_of_name - length($option->get_name())),
85                (
86                    $option->get_letter()
87                    ? q{ [-} . $option->get_letter() . q{]} : q{     }
88                ),
89                ($option->has_arg() ? q{ arg} : q{ } x 4),
90                $option->get_description(),
91            );
92        }
93    }
94    return $help;
95}
96
97################################################################################
98# Returns the general help string
99sub _get_help {
100    my ($self) = @_;
101    my $release = $self->_get_release();
102
103    # FIXME: can do with using Text::Template or Perl6::Form
104    my $prog = Fcm::Config->instance()->setting('FCM_COMMAND');
105    my $return = sprintf(
106          qq{usage: %s <subcommand> [options] [args]\n}
107        . qq{Flexible configuration management system, release %s.\n}
108        . qq{Type "%s help <subcommand>" for help on a specific subcommand\n}
109        . qq{\n}
110        . qq{Available subcommands:\n}
111        ,
112        $prog, $release, $prog,
113    );
114    for my $subcommand (Fcm::CLI::Config->instance()->get_core_subcommands()) {
115        $return .= sprintf(qq{  %s\n}, $subcommand->as_string());
116    }
117
118    my @lines = run_command(
119        [qw/svn help/], DEVNULL => 1, METHOD => 'qx', ERROR => 'ignore',
120    );
121    if (@lines) {
122        for my $subcommand (Fcm::CLI::Config->instance()->get_vc_subcommands()) {
123            if (defined($subcommand->get_synopsis())) {
124                $return .= sprintf(qq{  %s\n}, $subcommand->as_string());
125            }
126            else {
127                $return .= qq{  <version control system commands, see below>\n};
128            }
129        }
130        $return .= "\n=> svn help\n". join(q{}, @lines);
131    }
132    return $return;
133}
134
135################################################################################
136# Returns the release number of the current program
137sub _get_release {
138    my ($self) = @_;
139    my $release  = Fcm::Config->instance()->setting('FCM_RELEASE');
140    my $rev_file = Fcm::Config->instance()->setting('FCM_REV_FILE');
141    if (-r $rev_file) {
142        my $handle = IO::File->new($rev_file, 'r');
143        if ($handle) {
144            my $rev = $handle->getline();
145            $handle->close();
146            chomp($rev);
147            if ($rev) {
148                $release .= qq{ (r$rev)};
149            }
150        }
151    }
152    return $release;
153}
154
1551;
156__END__
157
158=head1 NAME
159
160Fcm::CLI::Invoker::Help
161
162=head1 SYNOPSIS
163
164    use Fcm::CLI::Invoker::Help;
165    $invoker = Fcm::CLI::Invoker::Help->new({
166        command   => $command,
167        options   => \%options,
168        arguments => $arguments,
169    });
170    $invoker->invoke();
171
172=head1 DESCRIPTION
173
174This class extends L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> an inherits all its
175methods. An object of this class is used to provide help on the command line
176interface.
177
178=head1 METHODS
179
180See L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> for a list of inherited methods.
181
182=over 4
183
184=item invoke()
185
186Provides help. If a subcommand name is specified in the argument, provides help
187for the specified subcommand. If a subcommand name is not specified, provides
188general CLI help.
189
190=back
191
192=head1 DIAGNOSTICS
193
194=over 4
195
196=item L<Fcm::CLI::Exception|Fcm::CLI::Exception>
197
198The invoke() method can croak() with this exception if the specified subcommand
199cannot be identified.
200
201=back
202
203=head1 TO DO
204
205Unit tests.
206
207Separate logic in this module with that of L<Fcm::CLI::Config|Fcm::CLI::Config>.
208
209Decouples help formatter with this invoker.
210
211=head1 SEE ALSO
212
213L<Fcm::CLI::Exception|Fcm::CLI::Exception>,
214L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>
215
216=head1 COPYRIGHT
217
218E<169> Crown copyright Met Office. All rights reserved.
219
220=cut
Note: See TracBrowser for help on using the repository browser.