source: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI.pm @ 5209

Last change on this file since 5209 was 5129, checked in by abarral, 4 months ago

Re-add removed by mistake fcm
File size: 9.0 KB
Line 
1# ------------------------------------------------------------------------------
2# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
3#
4# This file is part of FCM, tools for managing and building source code.
5#
6# FCM is free software: you can redistribute it and/or modify
7# it under the terms of the GNU General Public License as published by
8# the Free Software Foundation, either version 3 of the License, or
9# (at your option) any later version.
10#
11# FCM is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14# GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License
17# along with FCM. If not, see <http://www.gnu.org/licenses/>.
18# ------------------------------------------------------------------------------
19use strict;
20use warnings;
21
22# ------------------------------------------------------------------------------
23package FCM::CLI;
24use base qw{FCM::Class::CODE};
25
26use FCM::CLI::Exception;
27use FCM::CLI::Parser;
28use FCM::Context::Event;
29use FCM::System;
30use FindBin;
31use File::Basename        qw{dirname};
32use File::Spec::Functions qw{catfile rel2abs};
33use Pod::Usage            qw{pod2usage};
34
35my $E = 'FCM::CLI::Exception';
36our $EVENT;
37our $S;
38our %ACTION_OF = (
39    # Commands handled by FCM
40    'add'           => _opt_func('check', sub {$S->cm_check_unknown(@_)}),
41    'branch'        => \&_branch,
42    'branch-create' => _sys_func(sub {$S->cm_branch_create(@_)}),
43    'branch-delete' => _sys_func(sub {$S->cm_branch_delete(@_)}),
44    'branch-diff'   => _sys_func(sub {$S->cm_branch_diff(@_)}),
45    'branch-info'   => _sys_func(sub {$S->cm_branch_info(@_)}),
46    'branch-list'   => _sys_func(sub {$S->cm_branch_list(@_)}),
47    'browse'        => _sys_func(sub {$S->browse(@_)}),
48    'build'         => _sys_func(sub {$S->build(@_)}),
49    'cfg-print'     => _sys_func(sub {$S->config_parse(@_)}),
50    'checkout'      => _sys_func(sub {$S->cm_checkout(@_)}),
51    'cmp-ext-cfg'   => _sys_func(sub {$S->config_compare(@_)}),
52    'commit'        => _sys_func(sub {$S->cm_commit(@_)}),
53    'conflicts'     => _sys_func(sub {$S->cm_resolve_conflicts(@_)}),
54    'delete'        => _opt_func('check', sub {$S->cm_check_missing(@_)}),
55    'diff'          => _opt_func(
56        'branch', sub {$S->cm_branch_diff(@_)}, sub {$S->cm_diff(@_)},
57    ),
58    'export-items'  => _sys_func(sub {$S->export_items(@_)}),
59    'extract'       => _sys_func(sub {$S->extract(@_)}),
60    'gui'           => \&_gui,
61    'help'          => \&_help,
62    'keyword-print' => _sys_func(sub {$S->keyword_find(@_)}),
63    'loc-layout'    => _sys_func(sub {$S->cm_loc_layout(@_)}),
64    'merge'         => _sys_func(sub {$S->cm_merge(@_)}),
65    'mkpatch'       => _sys_func(sub {$S->cm_mkpatch(@_)}),
66    'make'          => _sys_func(sub {$S->make(@_)}),
67    'project-create'=> _sys_func(sub {$S->cm_project_create(@_)}),
68    'switch'        => _opt_func(
69        'relocate', sub {$S->svn(@_)}, sub {$S->cm_switch(@_)},
70    ),
71    'test-battery'  => \&_test_battery,
72    'update'        => _sys_func(sub {$S->cm_update(@_)}),
73    'version'       => \&_version,
74    # Commands passed directly to "svn"
75    map {($_ => _sys_func())} qw{
76        blame
77        cat
78        cleanup
79        copy
80        export
81        import
82        info
83        list
84        lock
85        log
86        mergeinfo
87        mkdir
88        move
89        patch
90        propdel
91        propedit
92        propget
93        proplist
94        propset
95        relocate
96        resolve
97        resolved
98        revert
99        status
100        unlock
101        upgrade
102    },
103);
104# List of overridden subcommands that need to display "svn help"
105our %CLI_MORE_HELP_FOR = map {($_, 1)} (qw{add delete diff switch update});
106
107# Creates the class.
108__PACKAGE__->class(
109    {'gui' => '$', 'parser' => 'FCM::CLI::Parser', 'system' => 'FCM::System'},
110    {   init => sub {
111            my $attrib_ref = shift();
112            $attrib_ref->{parser} ||= FCM::CLI::Parser->new();
113            $attrib_ref->{system}
114                ||= FCM::System->new({'gui' => $attrib_ref->{'gui'}});
115        },
116        action_of => {main => \&_main},
117    },
118);
119
120# The main CLI action.
121sub _main {
122    my ($attrib_ref, @argv) = @_;
123    local($EVENT) = sub {$attrib_ref->{system}->util()->event(@_)};
124    my ($app, $option_ref, @args) = eval {$attrib_ref->{parser}->parse(@argv)};
125    if (my $e = $@) {
126        _err($attrib_ref, \@argv, $e);
127    }
128    if (!$app || $option_ref->{help}) {
129        return _help($attrib_ref, $app);
130    }
131    $option_ref ||= {};
132    my $q = $option_ref->{quiet}   || 0;
133    my $v = $option_ref->{verbose} || 0;
134    my $reporter = $attrib_ref->{system}->util()->util_of_report();
135    my $verbosity = $reporter->DEFAULT + $v - $q;
136    if (exists($ENV{FCM_DEBUG}) && $ENV{FCM_DEBUG} eq 'true') {
137        $verbosity = $reporter->DEBUG;
138    }
139    $reporter->get_ctx_of_stderr()->set_verbosity($verbosity);
140    $reporter->get_ctx_of_stdout()->set_verbosity($verbosity);
141    my @context = eval {
142        if (!exists($ACTION_OF{$app})) {
143            return $E->throw($E->APP, \@argv);
144        }
145        $ACTION_OF{$app}->($attrib_ref, $app, $option_ref, @args);
146    };
147    if (my $e = $@) {
148        return _err($attrib_ref, \@argv, $e);
149    }
150}
151
152# "fcm branch".
153sub _branch {
154    my ($attrib_ref, $app, $option_ref, @args) = @_;
155    my $method
156        = exists($option_ref->{create}) ? 'cm_branch_create'
157        : exists($option_ref->{delete}) ? 'cm_branch_delete'
158        : exists($option_ref->{list})   ? 'cm_branch_list'
159        :                                 'cm_branch_info'
160        ;
161    if ($option_ref->{create}) {
162        if (!$option_ref->{name}) {
163            return $E->throw($E->OPT, [$app, @args]);
164        }
165        my $name = delete($option_ref->{name});
166        unshift(@args, $name);
167    }
168    $attrib_ref->{system}->($method, $option_ref, @args);
169}
170
171# Handles FCM::Exception.
172sub _err {
173    my ($attrib_ref, $argv_ref, $e) = @_;
174    $EVENT->(FCM::Context::Event->E, $e) || die($e);
175    die("\n");
176}
177
178# "fcm gui".
179sub _gui {
180    my ($attrib_ref, $app, $option_ref, @args) = @_;
181    exec("$FindBin::Bin/fcm_gui", @args);
182}
183
184# Implements "fcm help" and usage.
185sub _help {
186    my ($attrib_ref, $app, $option_ref, @args) = @_;
187    $app ||= 'help';
188    my @keys = ($app eq 'help' && @args) ? @args : (q{});
189    for my $key (@keys) {
190        if (exists($FCM::CLI::Parser::PREF_NAME_OF{$key})) {
191            $key = $FCM::CLI::Parser::PREF_NAME_OF{$key};
192        }
193        my $pod
194            = $key ? catfile(dirname($INC{'FCM/CLI.pm'}), 'CLI', "fcm-$key.pod")
195            :        $0
196            ;
197        if ($pod eq $0) {
198            _version($attrib_ref, $app, $option_ref, @args);
199        }
200        my $has_pod = -f $pod;
201        if ($has_pod) {
202            my $reporter = $attrib_ref->{system}->util()->util_of_report();
203            my $verbosity = $reporter->get_ctx_of_stdout()->get_verbosity();
204            pod2usage({
205                '-exitval' => 'NOEXIT',
206                '-input'   => $pod,
207                '-verbose' => $verbosity,
208            });
209        }
210        if (!$has_pod || exists($CLI_MORE_HELP_FOR{$key})) {
211            $attrib_ref->{system}->svn('help', {}, $key ? $key : ())
212        }
213    }
214    return;
215}
216
217# "fcm test-battery".
218sub _test_battery {
219    my ($attrib_ref, $app, $option_ref, @args) = @_;
220    exec("$FindBin::Bin/fcm_test_battery", @args);
221}
222
223# Returns a function that select the alternate handler for the application. The
224# handler is either $method_id (if $opt_id is set) or "svn".
225sub _opt_func {
226    my ($opt_id, $code0_ref, $code1_ref) = @_;
227    $code0_ref = _sys_func($code0_ref);
228    $code1_ref = _sys_func($code1_ref);
229    sub {
230        my ($attrib_ref, $app, $option_ref, @args) = @_;
231        my $code_ref = exists($option_ref->{$opt_id}) ? $code0_ref : $code1_ref;
232        $code_ref->($attrib_ref, $app, $option_ref, @args);
233    };
234}
235
236# Invokes a system function.
237sub _sys_func {
238    my ($code_ref) = @_;
239    sub {
240        my ($attrib_ref, $app, @args) = @_;
241        local($S) = $attrib_ref->{system};
242        defined($code_ref) ? $code_ref->(@args) : $S->svn($app, @args);
243    };
244}
245
246# Implements "fcm version".
247sub _version {
248    my ($attrib_ref, $app, $option_ref, @args) = @_;
249    my $version = $attrib_ref->{system}->util()->version();
250    $EVENT->(FCM::Context::Event->OUT, "FCM $version\n");
251}
252
253# ------------------------------------------------------------------------------
2541;
255__END__
256
257=head1 NAME
258
259FCM::CLI
260
261=head1 SYNOPSIS
262
263    my $cli = FCM::CLI->new();
264    $cli->(@ARGV);
265
266=head1 DESCRIPTION
267
268An implementation of the FCM command line interface.
269
270=head1 METHODS
271
272=over 4
273
274=item $class->new()
275
276Returns a new instance.
277
278=item $cli->(@ARGV)
279
280Determines the application using the first element in @ARGV, parses the options
281and arguments according to the application, and invokes the application.
282
283=back
284
285=head1 DIAGNOSTICS
286
287=head2 FCM::CLI::Exception
288
289This exception is thrown when the CLI fails to invoke an application.
290
291=head1 COPYRIGHT
292
293Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
294
295=cut
Note: See TracBrowser for help on using the repository browser.